home *** CD-ROM | disk | FTP | other *** search
(********************************************************************* * DSPack 2.3 * * * * home page : http://www.progdigy.com * * email : hgourvest@progdigy.com * * Thanks to Michael Andersen. (DSVideoWindowEx) * * * * date : 21-02-2003 * * * * The contents of this file are used with permission, subject to * * the Mozilla Public License Version 1.1 (the "License"); you may * * not use this file except in compliance with the License. You may * * obtain a copy of the License at * * http://www.mozilla.org/MPL/MPL-1.1.html * * * * Software distributed under the License is distributed on an * * "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or * * implied. See the License for the specific language governing * * rights and limitations under the License. * * * *********************************************************************) { @abstract(DSPack Components.) @author(Henri Gourvest: hgourvest@progdigy.com) @created(Mar 14, 2002) @lastmod(Feb 21, 2003) } {$IFDEF VER140} {$WARN SYMBOL_DEPRECATED OFF} {$ENDIF} {$IFDEF VER150} {$WARN SYMBOL_DEPRECATED OFF} {$WARN UNSAFE_CODE OFF} {$WARN UNSAFE_TYPE OFF} {$WARN UNSAFE_CAST OFF} {$ENDIF} {$ALIGN ON} {$MINENUMSIZE 4} unit DSPack; interface uses Windows, Classes, SysUtils, Messages, Graphics, Forms, Controls, ActiveX, DirectShow9, DirectDraw, DSUtil, ComCtrls, MMSystem, Math, Consts, ExtCtrls, MultiMon, Dialogs, Registry, SyncObjs, Direct3D9, WMF9; const { Filter Graph message identifier. } WM_GRAPHNOTIFY = WM_APP + 1; { Sample Grabber message identifier. } WM_CAPTURE_BITMAP = WM_APP + 2; type { Video mode to use with @link(TVideoWindow). } TVideoMode = ( vmNormal, vmVMR ); { Graph Mode to use with @link(TFilterGraph).} TGraphMode = ( gmNormal, gmCapture, gmDVD ); { Render device returned by then OnGraphVMRRenderDevice event. } {$IFDEF VER140} TVMRRenderDevice = ( rdOverlay = 1, rdVidMem = 2, rdSysMem = 4 ); {$ELSE} TVMRRenderDevice = Integer; const rdOverlay = 1; rdVidMem = 2; rdSysMem = 4; type {$ENDIF} {@exclude} TGraphState = ( gsUninitialized, gsStopped, gsPaused, gsPlaying ); { Specifies the seeking capabilities of a media stream. } TSeekingCap = ( CanSeekAbsolute, // The stream can seek to an absolute position. CanSeekForwards, // The stream can seek forward. CanSeekBackwards, // The stream can seek backward. CanGetCurrentPos, // The stream can report its current position. CanGetStopPos, // The stream can report its stop position. CanGetDuration, // The stream can report its duration. CanPlayBackwards, // The stream can play backward. CanDoSegments, // The stream can do seamless looping (see IMediaSeeking.SetPositions). Source // Reserved. ); { Specifies the seeking capabilities of a media stream. } TSeekingCaps = set of TSeekingCap; { Video Mixer Render Preferences: <br> <b>vpForceOffscreen:</b> Indicates that the VMR should use only offscreen surfaces for rendering.<br> <b>vpForceOverlays:</b> Indicates that the VMR should fail if no overlay surfaces are available.<br> <b>vpForceMixer:</b> Indicates that the VMR must use Mixer when the number of streams is 1.<br> <b>vpDoNotRenderColorKeyAndBorder:</b> Indicates that the application is responsible for painting the color keys.<br> <b>vpRestrictToInitialMonitor:</b> Indicates that the VMR should output only to the initial monitor.<br> <b>vpPreferAGPMemWhenMixing:</b> Indicates that the VMR should attempt to use AGP memory when allocating texture surfaces.} TVMRPreference = ( vpForceOffscreen, vpForceOverlays, vpForceMixer, vpDoNotRenderColorKeyAndBorder, vpRestrictToInitialMonitor, vpPreferAGPMemWhenMixing ); { Pointer to @link(TVMRPreferences).} PVMRPreferences = ^TVMRPreferences; { Set of @link(TVMRPreference).} TVMRPreferences = set of TVMRPreference; TOnDSEvent = procedure(sender: TComponent; Event, Param1, Param2: Integer) of object; {@exclude} TOnGraphBufferingData = procedure(sender: TObject; Buffering: boolean) of object ; {@exclude} TOnGraphComplete = procedure(sender: TObject; Result: HRESULT; Renderer: IBaseFilter) of object ; {@exclude} TOnGraphDeviceLost = procedure(sender: TObject; Device: IUnknown; Removed: Boolean) of object ; {@exclude} TOnGraphEndOfSegment = procedure(sender: TObject; StreamTime: TReferenceTime; NumSegment: Cardinal) of object ; {@exclude} TOnDSResult = procedure(sender: TObject; Result: HRESULT) of object ; {@exclude} TOnGraphFullscreenLost = procedure(sender: TObject; Renderer: IBaseFilter) of object ; {@exclude} TOnGraphOleEvent = procedure(sender: TObject; String1, String2: WideString) of object ; {@exclude} TOnGraphOpeningFile = procedure(sender: TObject; opening: boolean) of object ; {@exclude} TOnGraphSNDDevError = procedure(sender: TObject; OccurWhen: TSndDevErr; ErrorCode: LongWord) of object ; {@exclude} TOnGraphStreamControl = procedure(sender: TObject; PinSender: IPin; Cookie: LongWord) of object ; {@exclude} TOnGraphStreamError = procedure(sender: TObject; Operation: HRESULT; Value: LongWord) of object ; {@exclude} TOnGraphVideoSizeChanged = procedure(sender: TObject; Width, height: word) of object ; {@exclude} TOnGraphTimeCodeAvailable = procedure(sender: TObject; From: IBaseFilter; DeviceID: LongWord) of object ; {@exclude} TOnGraphEXTDeviceModeChange = procedure(sender: TObject; NewMode, DeviceID: LongWord) of object ; {@exclude} TOnGraphVMRRenderDevice = procedure(sender: TObject; RenderDevice: TVMRRenderDevice) of object; {@exclude} TOnDVDAudioStreamChange = procedure(sender: TObject; stream, lcid: Integer; Lang: string) of object; {@exclude} TOnDVDCurrentTime = procedure(sender: TObject; Hours, minutes,seconds,frames,frate : Integer) of object; {@exclude} TOnDVDTitleChange = procedure(sender: TObject; title: Integer) of object; {@exclude} TOnDVDChapterStart = procedure(sender: TObject; chapter: Integer) of object; {@exclude} TOnDVDValidUOPSChange = procedure(sender: TObject; UOPS: Integer) of object; {@exclude} TOnDVDChange = procedure(sender: TObject; total,current: Integer) of object; {@exclude} TOnDVDStillOn = procedure(sender: TObject; NoButtonAvailable: boolean; seconds: Integer) of object; {@exclude} TOnDVDSubpictureStreamChange = procedure(sender: TObject; SubNum, lcid: Integer; Lang: string) of object; {@exclude} TOnDVDPlaybackRateChange = procedure(sender: TObject; rate: single) of object; {@exclude} TOnDVDParentalLevelChange = procedure(sender: TObject; level: Integer) of object; {@exclude} TOnDVDAnglesAvailable = procedure(sender: TObject; available: boolean) of object; {@exclude} TOnDVDButtonAutoActivated = procedure(sender: TObject; Button: Cardinal) of object; {@exclude} TOnDVDCMD = procedure(sender: TObject; CmdID: Cardinal) of object; {@exclude} TOnDVDCurrentHMSFTime = procedure(sender: TObject; HMSFTimeCode: TDVDHMSFTimeCode; TimeCode: TDVDTimeCode) of object; {@exclude} TOnDVDKaraokeMode = procedure(sender: TObject; Played: boolean) of object; {@exclude} TOnBuffer = procedure(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: longint) of object ; // ***************************************************************************** // IFilter // ***************************************************************************** {@exclude} TFilterOperation = ( foAdding, // Before the filter is added to graph. foAdded, // After the filter is added to graph. foRemoving, // Before the filter is removed from graph. foRemoved, // After the filter is removed from graph. foRefresh // Designer notification to Refresh the filter . ); {@exclude} IFilter = interface ['{887F94DA-29E9-44C6-B48E-1FBF0FB59878}'] { Return the IBaseFilter Interface (All DirectShow filters expose this interface). } function GetFilter: IBaseFilter; { Return the filter name (generally the component name). } function GetName: string; { Called by the @link(TFilterGraph) component, this method receive notifications on what the TFilterGraph is doing. if Operation = foGraphEvent then Param is the event code received by the FilterGraph.} procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0); end; {@exclude} TControlEvent = ( cePlay, cePause, ceStop, ceFileRendering, ceFileRendered, ceDVDRendering, ceDVDRendered, ceActive ); {@exclude} IEvent = interface ['{6C0DCD7B-1A98-44EF-A6D5-E23CBC24E620}'] { FilterGraph events. } procedure GraphEvent(Event, Param1, Param2: integer); { Control Events. } procedure ControlEvent(Event: TControlEvent; Param: integer = 0); end; // ***************************************************************************** // TFilterGraph // ***************************************************************************** { This component is the central component in DirectShow, the Filter Graph handle synchronization, event notification, and other aspects of the controlling the filter graph. } TFilterGraph = class(TComponent) private FActive : boolean; FAutoCreate : boolean; FHandle : THandle; // to capture events FMode : TGraphMode; FFilters: TInterfaceList; FGraphEvents: TInterfaceList; // builders FFilterGraph : IGraphBuilder; FCaptureGraph : ICaptureGraphBuilder2; FDVDGraph : IDvdGraphBuilder; // events interface FMediaEventEx : IMediaEventEx; // Graphedit FGraphEdit : boolean; FGraphEditID : Integer; // Log File FLogFileName: String; FLogFile: TFileStream; FOnActivate: TNotifyEvent; // All Events Code FOnDSEvent : TOnDSEvent; // Generic Graph Events FOnGraphBufferingData : TOnGraphBufferingData; FOnGraphClockChanged : TNotifyEvent; FOnGraphComplete : TOnGraphComplete; FOnGraphDeviceLost : TOnGraphDeviceLost; FOnGraphEndOfSegment : TOnGraphEndOfSegment; FOnGraphErrorStillPlaying : TOnDSResult; FOnGraphErrorAbort : TOnDSResult; FOnGraphFullscreenLost : TOnGraphFullscreenLost; FOnGraphChanged : TNotifyEvent; FOnGraphOleEvent : TOnGraphOleEvent; FOnGraphOpeningFile : TOnGraphOpeningFile; FOnGraphPaletteChanged : TNotifyEvent; FOnGraphPaused : TOnDSResult; FOnGraphQualityChange : TNotifyEvent; FOnGraphSNDDevInError : TOnGraphSNDDevError; FOnGraphSNDDevOutError : TOnGraphSNDDevError; FOnGraphStepComplete : TNotifyEvent; FOnGraphStreamControlStarted : TOnGraphStreamControl; FOnGraphStreamControlStopped : TOnGraphStreamControl; FOnGraphStreamErrorStillPlaying : TOnGraphStreamError; FOnGraphStreamErrorStopped : TOnGraphStreamError; FOnGraphUserAbort : TNotifyEvent; FOnGraphVideoSizeChanged : TOnGraphVideoSizeChanged; FOnGraphTimeCodeAvailable : TOnGraphTimeCodeAvailable; FOnGraphEXTDeviceModeChange : TOnGraphEXTDeviceModeChange; FOnGraphClockUnset : TNotifyEvent; FOnGraphVMRRenderDevice : TOnGraphVMRRenderDevice; FOnDVDAudioStreamChange : TOnDVDAudioStreamChange; FOnDVDCurrentTime : TOnDVDCurrentTime; FOnDVDTitleChange : TOnDVDTitleChange; FOnDVDChapterStart : TOnDVDChapterStart; FOnDVDAngleChange : TOnDVDChange; FOnDVDValidUOPSChange : TOnDVDValidUOPSChange; FOnDVDButtonChange : TOnDVDChange; FOnDVDChapterAutoStop : TNotifyEvent; FOnDVDStillOn : TOnDVDStillOn; FOnDVDStillOff : TNotifyEvent; FOnDVDSubpictureStreamChange : TOnDVDSubpictureStreamChange; FOnDVDNoFP_PGC : TNotifyEvent; FOnDVDPlaybackRateChange : TOnDVDPlaybackRateChange; FOnDVDParentalLevelChange : TOnDVDParentalLevelChange; FOnDVDPlaybackStopped : TNotifyEvent; FOnDVDAnglesAvailable : TOnDVDAnglesAvailable; FOnDVDPlayPeriodAutoStop : TNotifyEvent; FOnDVDButtonAutoActivated : TOnDVDButtonAutoActivated; FOnDVDCMDStart : TOnDVDCMD; FOnDVDCMDEnd : TOnDVDCMD; FOnDVDDiscEjected : TNotifyEvent; FOnDVDDiscInserted : TNotifyEvent; FOnDVDCurrentHMSFTime : TOnDVDCurrentHMSFTime; FOnDVDKaraokeMode : TOnDVDKaraokeMode; // DVD Warning FOnDVDWarningInvalidDVD1_0Disc : TNotifyEvent;//=1, FOnDVDWarningFormatNotSupported : TNotifyEvent;//=2, FOnDVDWarningIllegalNavCommand : TNotifyEvent;//=3 FOnDVDWarningOpen : TNotifyEvent;//=4 FOnDVDWarningSeek : TNotifyEvent;//=5 FOnDVDWarningRead : TNotifyEvent;//=6 // DVDDomain FOnDVDDomainFirstPlay : TNotifyEvent; FOnDVDDomainVideoManagerMenu : TNotifyEvent; FOnDVDDomainVideoTitleSetMenu : TNotifyEvent; FOnDVDDomainTitle : TNotifyEvent; FOnDVDDomainStop : TNotifyEvent; // DVDError FOnDVDErrorUnexpected : TNotifyEvent; FOnDVDErrorCopyProtectFail : TNotifyEvent; FOnDVDErrorInvalidDVD1_0Disc : TNotifyEvent; FOnDVDErrorInvalidDiscRegion : TNotifyEvent; FOnDVDErrorLowParentalLevel : TNotifyEvent; FOnDVDErrorMacrovisionFail : TNotifyEvent; FOnDVDErrorIncompatibleSystemAndDecoderRegions : TNotifyEvent; FOnDVDErrorIncompatibleDiscAndDecoderRegions : TNotifyEvent; procedure HandleEvents; procedure WndProc(var Msg: TMessage); procedure SetActive(Activate: boolean); procedure SetGraphMode(Mode: TGraphMode); procedure SetGraphEdit(enable: boolean); procedure ClearOwnFilters; procedure AddOwnFilters; procedure GraphEvents(Event, Param1, Param2: integer); procedure ControlEvents(Event: TControlEvent; Param: integer = 0); procedure SetLogFile(FileName: String); function GetState: TGraphState; function GetVolume: integer; procedure SetVolume(Volume: Integer); function GetBalance: integer; procedure SetBalance(Balance: integer); function GetSeekCaps: TSeekingCaps; procedure SetRate(Rate: double); function GetRate: double; function GetDuration: integer; protected {@exclude} procedure DoEvent(Event, Param1, Param2: Integer); virtual; {@exclude} procedure InsertFilter(AFilter: IFilter); {@exclude} procedure RemoveFilter(AFilter: IFilter); {@exclude} procedure InsertEventNotifier(AEvent: IEvent); {@exclude} procedure RemoveEventNotifier(AEvent: IEvent); public { Retrieve the total duration of a stream. } property Duration: Integer read GetDuration; { Retrieve/Set the rate. } property Rate: Double read GetRate write SetRate; { Retrieve the seeking capabilities. } property SeekCapabilities: TSeekingCaps read GetSeekCaps; { The volume balance. } property Balance: integer read GetBalance write SetBalance; { The volume. } property Volume: integer read GetVolume write SetVolume; { Current state of the filter graph. } property State: TGraphState read GetState; { TFilterGraph constructor. } constructor Create(AOwner: TComponent); override; { TFilterGraph destructor. } destructor Destroy; override; { @exclude} procedure Loaded; override; { Retrieve an Interface from the current Graph.<br> <b>ex: </b> (FilterGraph <b>as</b> IGraphBuilder).RenderFile('C:\speedis.avi', <b>nil</b>);<br> <b>Remark: </b> The interfaces you can Query depend of the @link(Mode) you have defined.<br> <b>gmNormal: </b>IAMGraphStreams, IAMStats, IBasicAudio, IBasicVideo, IBasicVideo2, IFilterChain, IFilterGraph, IFilterGraph2, IFilterMapper2, IGraphBuilder, IGraphConfig, IGraphVersion, IMediaControl, IMediaEvent, IMediaEventEx, IMediaEventSink, IMediaFilter, IMediaPosition, IMediaSeeking, IQueueCommand, IRegisterServiceProvider, IResourceManager, IServiceProvider, IVideoFrameStep, IVideoWindow. <br> <b>gmCapture: </b> all gmNormal interfaces and ICaptureGraphBuilder2.<br> <b>gmDVD: </b> all gmNormal interfaces and IDvdGraphBuilder, IDvdControl2, IDvdInfo2, IAMLine21Decoder.} function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; { The Run method runs all the filters in the filter graph. While the graph is running, data moves through the graph and is rendered. } function Play: boolean; { The Pause method pauses all the filters in the filter graph. } function Pause: boolean; { The Stop method stops all the filters in the graph. } function Stop: boolean; { This method disconnect all pins.} procedure DisconnectFilters; { Disconnect and remove all filters from the filter graph excepting the custom components. } procedure ClearGraph; { Render a single file. } function RenderFile(FileName: WideString): HRESULT; function RenderFileEx(FileName: WideString): HRESULT; { Render a DVD Video Volume or a File Name if specified. } function RenderDVD(out status: TAMDVDRenderStatus; FileName: WideString = ''; Mode: Integer = AM_DVD_HWDEC_PREFER): HRESULT; { Save the current state and position of a DVD movie to a file.<br> See also: @link(DVDRestoreBookmark).} procedure DVDSaveBookmark(BookMarkFile: WideString); { Restore the State and position of a DVD movie saved by @link(DVDSaveBookmark).} procedure DVDRestoreBookmark(BookMarkFile: WideString); published { Specify a File Name to save the Filter Graph Log. } property LogFile: String read FLogFileName write SetLogFile; { Activate the Filter Graph.} property Active: boolean read FActive write SetActive default False; { Auto-Activate the Filter Graph when component is created.} property AutoCreate: boolean read FAutoCreate write FAutoCreate default False; { There is 3 modes: gmNormal, gmCapture and gmDVD. <br> See also: @link(GraphInterFace).} property Mode: TGraphMode read FMode write SetGraphMode default gmNormal; { if true you can use GraphEdit application to connect with the Filter Graph.} property GraphEdit: boolean read FGraphEdit write SetGraphEdit; // ------------------------------------------------------------------------- // Events // ------------------------------------------------------------------------- property OnActivate: TNotifyEvent read FOnActivate write FOnActivate; { Generic Filter Graph event.<br> <b>Event:</b> message sent.<br> <b>Param1:</b> first message parameter.<br> <b>Param2:</b> second message parameter.} property OnDSEvent: TOnDSEvent read FOnDSEvent write FOnDSEvent; { The graph is buffering data, or has stopped buffering data. A filter can send this event if it needs to buffer data from an external source. (for example, it might be loading data from a network.) The application can use this event to adjust its user interface.<br> <b>buffering:</b> TRUE if the graph is starting to buffer, or FALSE if the graph has stopped buffering. } property OnGraphBufferingData: TOnGraphBufferingData read FOnGraphBufferingData write FOnGraphBufferingData; { The reference clock has changed. The filter graph manager sends this event when its IMediaFilter.SetSyncSource method is called.} property OnGraphClockChanged: TNotifyEvent read FOnGraphClockChanged write FOnGraphClockChanged; { All data from a particular stream has been rendered. By default, the filter graph manager does not forward this event to the application. However, after all the streams in the graph report EC_COMPLETE, the filter graph manager posts a separate EC_COMPLETE event to the application.<br> <b>Result:</b> HRESULT value; can be S_OK.<br> <b>Renderer:</b> nil, or a reference to the renderer's IBaseFilter interface.} property OnGraphComplete: TOnGraphComplete read FOnGraphComplete write FOnGraphComplete; { A Plug and Play device was removed or became available again. When the device becomes available again, the previous state of the device filter is no longer valid. The application must rebuild the graph in order to use the device.<br> <b>Device:</b> IUnknown interface of the filter that represents the device.<br> <b>Removed:</b> True if the device was removed, or False if the device is available again.} property OnGraphDeviceLost: TOnGraphDeviceLost read FOnGraphDeviceLost write FOnGraphDeviceLost; { The end of a segment was reached. This event code supports seamless looping. When a call to the IMediaSeeking.SetPositions method includes the AM_SEEKING_Segment flag, the source filter sends this event code instead of calling IPin.EndOfStream.<br> <b>StreamTime:</b> TREFERENCE_TIME value that specifies the accumulated stream time since the start of the segment.<br> <b>NumSegment:</b> Cardinal value indicating the segment number (zero-based).} property OnGraphEndOfSegment: TOnGraphEndOfSegment read FOnGraphEndOfSegment write FOnGraphEndOfSegment; { An asynchronous command to run the graph has failed. if the filter graph manager issues an asynchronous run command that fails, it sends this event to the application. The graph remains in a running state. The state of the underlying filters is indeterminate. Some filters might be running, others might not.<br> <b>Result:</b> value of the operation that failed.} property OnGraphErrorStillPlaying: TOnDSResult read FOnGraphErrorStillPlaying write FOnGraphErrorStillPlaying; { An operation was aborted because of an error.<br> <b>Result:</b> value of the operation that failed.} property OnGraphErrorAbort: TOnDSResult read FOnGraphErrorAbort write FOnGraphErrorAbort; { The video renderer is switching out of full-screen mode. When the Full Screen Renderer loses activation, it sends this event. When another video renderer switches out of full-screen mode, the filter graph manager sends this event, in response to an EC_ACTIVATE event from the renderer.<br> <b>Renderer:</b> the video renderer's IBaseFilter interface, or nil.} property OnGraphFullscreenLost: TOnGraphFullscreenLost read FOnGraphFullscreenLost write FOnGraphFullscreenLost; { The filter graph has changed. This event code is intended for debugging. It is not sent for all graph changes.} property OnGraphChanged: TNotifyEvent read FOnGraphChanged write FOnGraphChanged; { A filter is passing a text string to the application. By convention, the first parameter contains type information (for example, Text) and the second parameter contains the text string.<br> <b>String1, String2:</b> Wide Strings} property OnGraphOleEvent: TOnGraphOleEvent read FOnGraphOleEvent write FOnGraphOleEvent; { The graph is opening a file, or has finished opening a file. A filter can send this event if it spends significant time opening a file. (for example, the file might be located on a network.) The application can use this event to adjust its user interface.<br> <b>opening:</b> TRUE if the graph is starting to open a file, or FALSE if the graph is no longer opening the file.} property OnGraphOpeningFile: TOnGraphOpeningFile read FOnGraphOpeningFile write FOnGraphOpeningFile; { The video palette has changed. Video renderers send this event if they detect a palette change in the stream.} property OnGraphPaletteChanged: TNotifyEvent read FOnGraphPaletteChanged write FOnGraphPaletteChanged; { A pause request has completed. The filter graph manager sends this event when it completes an asynchronous pause command.<br> <b>Result:</b> value that indicates the result of the transition. if the value is S_OK, the filter graph is now in a paused state.} property OnGraphPaused: TOnDSResult read FOnGraphPaused write FOnGraphPaused; { The graph is dropping samples, for quality control. A filter sends this event if it drops samples in response to a quality control message. It sends the event only when it adjusts the quality level, not for each sample that it drops. } property OnGraphQualityChange: TNotifyEvent read FOnGraphQualityChange write FOnGraphQualityChange; { An audio device error occurred on an input pin.<br> <b>OccurWhen:</b> value from the TSNDDEV_ERR enumerated type, indicating how the device was being accessed when the failure occurred.<br> <b>ErrorCode:</b> value indicating the error returned from the sound device call.} property OnGraphSNDDevInError: TOnGraphSNDDevError read FOnGraphSNDDevInError write FOnGraphSNDDevInError; { An audio device error occurred on an output pin.<br> <b>OccurWhen:</b> value from the TSNDDEV_ERR enumerated type, indicating how the device was being accessed when the failure occurred.<br> <b>ErrorCode:</b> value indicating the error returned from the sound device call.} property OnGraphSNDDevOutError: TOnGraphSNDDevError read FOnGraphSNDDevOutError write FOnGraphSNDDevOutError; { A filter has completed frame stepping. The filter graph manager pauses the graph and passes the event to the application.} property OnGraphStepComplete: TNotifyEvent read FOnGraphStepComplete write FOnGraphStepComplete; { A stream-control start command has taken effect. Filters send this event in response to the IAMStreamControl.StartAt method. This method specifies a reference time for a pin to begin streaming. When streaming does begin, the filter sends this event.<br> <b>PinSender</b> parameter specifies the pin that executes the start command. Depending on the implementation, it might not be the pin that received the StartAt call.<br> <b>Cookie</b> parameter is specified by the application in the StartAt method. This parameter enables the application to track multiple calls to the method.} property OnGraphStreamControlStarted: TOnGraphStreamControl read FOnGraphStreamControlStarted write FOnGraphStreamControlStarted; { A stream-control start command has taken effect. Filters send this event in response to the IAMStreamControl.StopAt method. This method specifies a reference time for a pin to stop streaming. When streaming does halt, the filter sends this event.<br> <b>PinSender</b> parameter specifies the pin that executes the stop command. Depending on the implementation, it might not be the pin that received the StopAt call.<br> <b>Cookie</b> parameter is specified by the application in the StopAt method. This parameter enables the application to track multiple calls to the method.} property OnGraphStreamControlStopped: TOnGraphStreamControl read FOnGraphStreamControlStopped write FOnGraphStreamControlStopped; { An error occurred in a stream, but the stream is still playing.<br> <b>Operation:</b> HRESULT of the operation that failed.<br> <b>Value:</b> LongWord value, generally zero. } property OnGraphStreamErrorStillPlaying : TOnGraphStreamError read FOnGraphStreamErrorStillPlaying write FOnGraphStreamErrorStillPlaying; { A stream has stopped because of an error.<br> <b>Operation:</b> HRESULT of the operation that failed.<br> <b>Value:</b> LongWord value, generally zero. } property OnGraphStreamErrorStopped: TOnGraphStreamError read FOnGraphStreamErrorStopped write FOnGraphStreamErrorStopped; { The user has terminated playback.<br> This event code signals that the user has terminated normal graph playback. for example, video renderers send this event if the user closes the video window.<br> After sending this event, the filter should reject all samples and not send any EC_REPAINT events, until the filter stops and is reset.} property OnGraphUserAbort: TNotifyEvent read FOnGraphUserAbort write FOnGraphUserAbort; { The native video size has changed.<br> <b>width:</b> new width, in pixels.<br> <b>height:</b> new height, in pixels. } property OnGraphVideoSizeChanged: TOnGraphVideoSizeChanged read FOnGraphVideoSizeChanged write FOnGraphVideoSizeChanged; { Sent by filter supporting timecode.<br> <b>From:</b> sending object.<br> <b>DeviceID:</b> device ID of the sending object} property OnGraphTimeCodeAvailable: TOnGraphTimeCodeAvailable read FOnGraphTimeCodeAvailable write FOnGraphTimeCodeAvailable; { Sent by filter supporting IAMExtDevice.<br> <b>NewMode:</b> the new mode<br> <b>DeviceID:</b> the device ID of the sending object} property OnGraphEXTDeviceModeChange: TOnGraphEXTDeviceModeChange read FOnGraphEXTDeviceModeChange write FOnGraphEXTDeviceModeChange; { The clock provider was disconnected.<br> KSProxy signals this event when the pin of a clock-providing filter is disconnected.} property OnGraphClockUnset: TNotifyEvent read FOnGraphClockUnset write FOnGraphClockUnset; { Identifies the type of rendering mechanism the VMR is using to display video.} property OnGraphVMRRenderDevice: TOnGraphVMRRenderDevice read FOnGraphVMRRenderDevice write FOnGraphVMRRenderDevice; { Signals that the current audio stream number changed for the main title.<br> The current audio stream can change automatically with a navigation command authored on the disc as well as through application control by using the IDvdControl2 interface.<br> <b>stream:</b> value indicating the new user audio stream number. Audio stream numbers range from 0 to 7. Stream $FFFFFFFF indicates that no stream is selected.<br> <b>lcid:</b> Language identifier.<br> <b>Lang:</b> Language string. } property OnDVDAudioStreamChange: TOnDVDAudioStreamChange read FOnDVDAudioStreamChange write FOnDVDAudioStreamChange; { Deprecated, use @link(OnDVDCurrentHMSFTime) instead.<br> Signals the beginning of every video object unit (VOBU), a video segment which is 0.4 to 1.0 seconds in length.<br> } property OnDVDCurrentTime: TOnDVDCurrentTime read FOnDVDCurrentTime write FOnDVDCurrentTime; { Indicates when the current title number changes.<br> Title numbers range from 1 to 99. This number indicates the TTN, which is the title number with respect to the whole disc, not the VTS_TTN which is the title number with respect to just a current VTS.<br> <b>Title:</b> value indicating the new title number.} property OnDVDTitleChange: TOnDVDTitleChange read FOnDVDTitleChange write FOnDVDTitleChange; { Signals that the DVD player started playback of a new program in the DVD_DOMAIN_Title domain.<br> Only simple linear movies signal this event.<br> <b>chapter:</b> value indicating the new chapter (program) number.} property OnDVDChapterStart: TOnDVDChapterStart read FOnDVDChapterStart write FOnDVDChapterStart; { Signals that either the number of available angles changed or that the current angle number changed.<br> Angle numbers range from 1 to 9. The current angle number can change automatically with a navigation command authored on the disc as well as through application control by using the IDvdControl2 interface.<br> <b>total:</b> value indicating the number of available angles. When the number of available angles is 1, the current video is not multiangle.<br> <b>current:</b> value indicating the current angle number.} property OnDVDAngleChange: TOnDVDChange read FOnDVDAngleChange write FOnDVDAngleChange; { Signals that the available set of IDvdControl2 interface methods has changed.<br> <b>UOPS:</b> value representing a ULONG whose bits indicate which IDvdControl2 commands the DVD disc explicitly disabled. } property OnDVDValidUOPSChange: TOnDVDValidUOPSChange read FOnDVDValidUOPSChange write FOnDVDValidUOPSChange; { Signals that either the number of available buttons changed or that the currently selected button number changed.<br> This event can signal any of the available button numbers. These numbers do not always correspond to button numbers used for IDvdControl2.SelectAndActivateButton because that method can activate only a subset of buttons.<br> <b>total:</b> value indicating the number of available buttons.<br> <b>current:</b> value indicating the currently selected button number. Selected button number zero implies that no button is selected.} property OnDVDButtonChange: TOnDVDChange read FOnDVDButtonChange write FOnDVDButtonChange; { Indicates that playback stopped as the result of a call to the IDvdControl2.PlayChaptersAutoStop method.} property OnDVDChapterAutoStop: TNotifyEvent read FOnDVDChapterAutoStop write FOnDVDChapterAutoStop; { Signals the beginning of any still (PGC, Cell, or VOBU). All combinations of buttons and still are possible (buttons on with still on, buttons on with still off, button off with still on, button off with still off).<br> <b>NoButtonAvailable</b>: Boolean value indicating whether buttons are available. False indicates buttons are available so the IDvdControl2.StillOff method won't work. True indicates no buttons are available, so IDvdControl2.StillOff will work.<br> <b>seconds</b>: value indicating the number of seconds the still will last. $FFFFFFFF indicates an infinite still, meaning wait until the user presses a button or until the application calls IDvdControl2.StillOff.} property OnDVDStillOn: TOnDVDStillOn read FOnDVDStillOn write FOnDVDStillOn; { Signals the end of any still (PGC, Cell, or VOBU).<br> This event indicates that any currently active still has been released.} property OnDVDStillOff: TNotifyEvent read FOnDVDStillOff write FOnDVDStillOff; { Signals that the current subpicture stream number changed for the main title.<br> The subpicture can change automatically with a navigation command authored on disc as well as through application control using IDvdControl2.<br> <b>SubNum:</b> value indicating the new user subpicture stream number. Subpicture stream numbers range from 0 to 31. Stream $FFFFFFFF indicates that no stream is selected.<br> <b>lcid:</b> Language identifier.<br> <b>Lang:</b> Language string.} property OnDVDSubpictureStreamChange: TOnDVDSubpictureStreamChange read FOnDVDSubpictureStreamChange write FOnDVDSubpictureStreamChange; { Signals that the DVD disc does not have a FP_PGC (First Play Program Chain) and that the DVD Navigator will not automatically load any PGC and start playback.} property OnDVDNoFP_PGC: TNotifyEvent read FOnDVDNoFP_PGC write FOnDVDNoFP_PGC; { Signals that a rate change in the playback has been initiated. <b>rate:</b> indicate the new playback rate. rate < 0 indicates reverse playback mode. rate > 0 indicates forward playback mode.} property OnDVDPlaybackRateChange: TOnDVDPlaybackRateChange read FOnDVDPlaybackRateChange write FOnDVDPlaybackRateChange; { Signals that the parental level of the authored content is about to change.<br> The DVD Navigator source filter does not currently support "on the fly" parental level changes in response to SetTmpPML commands on a DVD disc.<br> <b>level:</b> value representing the new parental level set in the player.} property OnDVDParentalLevelChange: TOnDVDParentalLevelChange read FOnDVDParentalLevelChange write FOnDVDParentalLevelChange; { Indicates that playback has been stopped. The DVD Navigator has completed playback of the title or chapter and did not find any other branching instruction for subsequent playback. } property OnDVDPlaybackStopped: TNotifyEvent read FOnDVDPlaybackStopped write FOnDVDPlaybackStopped; { Indicates whether an angle block is being played and angle changes can be performed.<br> Angle changes are not restricted to angle blocks and the manifestation of the angle change can be seen only in an angle block.<br> <b>available:</b> Boolean value that indicates if an angle block is being played back. False indicates that playback is not in an angle block and angles are not available, True indicates that an angle block is being played back and angle changes can be performed.} property OnDVDAnglesAvailable: TOnDVDAnglesAvailable read FOnDVDAnglesAvailable write FOnDVDAnglesAvailable; { Indicates that the Navigator has finished playing the segment specified in a call to PlayPeriodInTitleAutoStop.} property OnDVDPlayPeriodAutoStop: TNotifyEvent read FOnDVDPlayPeriodAutoStop write FOnDVDPlayPeriodAutoStop; { Signals that a menu button has been automatically activated per instructions on the disc. This occurs when a menu times out and the disc has specified a button to be automatically activated.<br> <b>Button</b>: value indicating the button that was activated.} property OnDVDButtonAutoActivated: TOnDVDButtonAutoActivated read FOnDVDButtonAutoActivated write FOnDVDButtonAutoActivated; { Signals that a particular command has begun.<br> <b>CmdID:</b> The Command ID and the HRESULT return value.} property OnDVDCMDStart: TOnDVDCMD read FOnDVDCMDStart Write FOnDVDCMDStart; { Signals that a particular command has completed.<br> <b>CmdID</b> The Command ID and the completion result.} property OnDVDCMDEnd: TOnDVDCMD read FOnDVDCMDEnd Write FOnDVDCMDEnd; { Signals that a disc was ejected.<br> Playback automatically stops when a disc is ejected. The application does not have to take any special action in response to this event.} property OnDVDDiscEjected: TNotifyEvent read FOnDVDDiscEjected Write FOnDVDDiscEjected; { Signals that a disc was inserted into the drive.<br> Playback automatically begins when a disc is inserted. The application does not have to take any special action in response to this event.} property OnDVDDiscInserted: TNotifyEvent read FOnDVDDiscInserted write FOnDVDDiscInserted; { Signals the current time, in DVD_HMSF_TIMECODE format, relative to the start of the title. This event is triggered at the beginning of every VOBU, which occurs every 0.4 to 1.0 seconds.<br> The TDVD_HMSF_TIMECODE format is intended to replace the old BCD format that is returned in OnDVDCurrentTime events. The HMSF timecodes are easier to work with. To have the Navigator send EC_DVD_CURRENT_HMSF_TIME events instead of EC_DVD_CURRENT_TIME events, an application must call IDvdControl2.SetOption(DVD_HMSF_TimeCodeEvents, TRUE). When this flag is set, the Navigator will also expect all time parameters in the IDvdControl2 and IDvdInfo2 methods to be passed as TDVD_HMSF_TIMECODEs.<br> <b>HMSFTimeCode:</b> HMS Time code structure.<br> <b>TimeCode:</b> old time format, do not use. } property OnDVDCurrentHMSFTime: TOnDVDCurrentHMSFTime read FOnDVDCurrentHMSFTime write FOnDVDCurrentHMSFTime; { Indicates that the Navigator has either begun playing or finished playing karaoke data.<br> The DVD player signals this event whenever it changes domains.<br> <b>Played:</b> TRUE means that a karaoke track is being played and FALSE means that no karaoke data is being played. } property OnDVDKaraokeMode: TOnDVDKaraokeMode read FOnDVDKaraokeMode write FOnDVDKaraokeMode; { Performing default initialization of a DVD disc.} property OnDVDDomainFirstPlay: TNotifyEvent read FOnDVDDomainFirstPlay write FOnDVDDomainFirstPlay; { Displaying menus for whole disc. } property OnDVDDomainVideoManagerMenu: TNotifyEvent read FOnDVDDomainVideoManagerMenu write FOnDVDDomainVideoManagerMenu; { Displaying menus for current title set. } property OnDVDDomainVideoTitleSetMenu: TNotifyEvent read FOnDVDDomainVideoTitleSetMenu write FOnDVDDomainVideoTitleSetMenu; { Displaying the current title. } property OnDVDDomainTitle: TNotifyEvent read FOnDVDDomainTitle write FOnDVDDomainTitle; { The DVD Navigator is in the DVD Stop domain.} property OnDVDDomainStop: TNotifyEvent read FOnDVDDomainStop write FOnDVDDomainStop; { Something unexpected happened; perhaps content is authored incorrectly. Playback is stopped.} property OnDVDErrorUnexpected: TNotifyEvent read FOnDVDErrorUnexpected write FOnDVDErrorUnexpected; { Key exchange for DVD copy protection failed. Playback is stopped. } property OnDVDErrorCopyProtectFail: TNotifyEvent read FOnDVDErrorCopyProtectFail write FOnDVDErrorCopyProtectFail; { DVD-Video disc is authored incorrectly for specification version 1.x. Playback is stopped.} property OnDVDErrorInvalidDVD1_0Disc: TNotifyEvent read FOnDVDErrorInvalidDVD1_0Disc write FOnDVDErrorInvalidDVD1_0Disc; { DVD-Video disc cannot be played because the disc is not authored to play in the system region. } property OnDVDErrorInvalidDiscRegion: TNotifyEvent read FOnDVDErrorInvalidDiscRegion write FOnDVDErrorInvalidDiscRegion; { Player parental level is lower than the lowest parental level available in the DVD content. Playback is stopped. } property OnDVDErrorLowParentalLevel: TNotifyEvent read FOnDVDErrorLowParentalLevel write FOnDVDErrorLowParentalLevel; { Macrovision« distribution failed. Playback stopped. } property OnDVDErrorMacrovisionFail: TNotifyEvent read FOnDVDErrorMacrovisionFail write FOnDVDErrorMacrovisionFail; { No discs can be played because the system region does not match the decoder region. } property OnDVDErrorIncompatibleSystemAndDecoderRegions: TNotifyEvent read FOnDVDErrorIncompatibleSystemAndDecoderRegions write FOnDVDErrorIncompatibleSystemAndDecoderRegions; { The disc cannot be played because the disc is not authored to be played in the decoder's region. } property OnDVDErrorIncompatibleDiscAndDecoderRegions: TNotifyEvent read FOnDVDErrorIncompatibleDiscAndDecoderRegions write FOnDVDErrorIncompatibleDiscAndDecoderRegions; { DVD-Video disc is authored incorrectly. Playback can continue, but unexpected behavior might occur. } property OnDVDWarningInvalidDVD1_0Disc: TNotifyEvent read FOnDVDWarningInvalidDVD1_0Disc write FOnDVDWarningInvalidDVD1_0Disc; { A decoder would not support the current format. Playback of a stream (audio, video or subpicture) might not function. } property OnDVDWarningFormatNotSupported : TNotifyEvent read FOnDVDWarningFormatNotSupported write FOnDVDWarningFormatNotSupported; { The internal DVD navigation command processor attempted to process an illegal command.} property OnDVDWarningIllegalNavCommand : TNotifyEvent read FOnDVDWarningIllegalNavCommand write FOnDVDWarningIllegalNavCommand; { File Open failed. } property OnDVDWarningOpen: TNotifyEvent read FOnDVDWarningOpen write FOnDVDWarningOpen; { File Seek failed. } property OnDVDWarningSeek: TNotifyEvent read FOnDVDWarningSeek write FOnDVDWarningSeek; { File Read failed. } property OnDVDWarningRead: TNotifyEvent read FOnDVDWarningRead write FOnDVDWarningRead; end; // ***************************************************************************** // TVMROptions // ***************************************************************************** {@exclude} TVideoWindow = class; { See VRMOptions.<br>} TVMRVideoMode = ( vmrWindowed, vmrWindowless, vmrRenderless ); { Video Mixer Renderer property editor. } TVMROptions = class(TPersistent) private FOwner: TVideoWindow; FStreams: cardinal; FPreferences: TVMRPreferences; FMode: TVMRVideoMode; FKeepAspectRatio: boolean; procedure SetStreams(Streams: cardinal); procedure SetPreferences(Preferences: TVMRPreferences); procedure SetMode(AMode: TVMRVideoMode); procedure SetKeepAspectRatio(Keep: boolean); public { Constructor method. } constructor Create(AOwner: TVideoWindow); published { Windowed or WindowLess} property Mode: TVMRVideoMode read FMode write SetMode; { Sets the number of streams to be mixed. } property Streams: Cardinal read FStreams write SetStreams default 4; { Sets various application preferences related to video rendering. } property Preferences: TVMRPreferences read FPreferences write SetPreferences default [vpForceMixer]; { Keep Aspect Ration on the video window. } property KeepAspectRatio: boolean read FKeepAspectRatio write SetKeepAspectRatio default True; end; // ***************************************************************************** // TVideoWindow // ***************************************************************************** TAbstractAllocator = class(TInterfacedObject) constructor Create(out hr: HResult; wnd: THandle; d3d: IDirect3D9 = nil; d3dd: IDirect3DDevice9 = nil); virtual; abstract; end; TAbstractAllocatorClass = class of TAbstractAllocator; { Manage a Video Renderer or a Video Mixer Renderer (VMR) Filter to display a video in your application. } TVideoWindow = class(TCustomControl, IFilter, IEvent) private FMode : TVideoMode; FVMROptions : TVMROptions; FBaseFilter : IBaseFilter; FVideoWindow : IVideoWindow; // VMR Windowed & Normal FWindowLess : IVMRWindowlessControl9; // VMR Windowsless FFullScreen : boolean; FFilterGraph : TFilterGraph; FWindowStyle : LongWord; FWindowStyleEx : LongWord; FTopMost : boolean; FIsFullScreen : boolean; FOnPaint : TNotifyEvent; FKeepAspectRatio: boolean; FAllocatorClass: TAbstractAllocatorClass; FCurrentAllocator: TAbstractAllocator; FRenderLessUserID: Cardinal; procedure SetVideoMode(AMode: TVideoMode); procedure SetFilterGraph(AFilterGraph: TFilterGraph); procedure SetFullScreen(Value: boolean); procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0); procedure GraphEvent(Event, Param1, Param2: integer); function GetName: string; function GetVideoHandle: THandle; procedure ControlEvent(Event: TControlEvent; Param: integer = 0); procedure SetTopMost(TopMost: boolean); function GetVisible: boolean; procedure SetVisible(Vis: boolean); protected {@exclude} procedure Loaded; override; {@exclude} procedure Notification(AComponent: TComponent; Operation: TOperation); override; {@exclude} procedure Resize; override; {@exclude} procedure ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); override; {@exclude} function GetFilter: IBaseFilter; {@exclude} procedure WndProc(var Message: TMessage); override; {@exclude} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure Paint; override; public {@exclude} function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; { Constructor. } constructor Create(AOwner: TComponent);override; { Destructor. } destructor Destroy; override; { Check if the Video Mixer Renderer is available (Windows XP). } class function CheckVMR: boolean; { Retrieve the current bitmap, only in WindowLess VMR Mode. } function VMRGetBitmap(Stream: TStream): boolean; function CheckInputPinsConnected: boolean; procedure SetAllocator(Allocator: TAbstractAllocatorClass; UserID: Cardinal); published { VMR/WindowsLess Mode only.} property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; { The video Window stay on Top in FullScreen Mode. } property FullScreenTopMost: boolean read FTopMost write SetTopMost default false; { Video Mode, you can use Normal mode or VMR mode (VMR is only available on WindowsXP). } property Mode: TVideoMode read FMode write SetVideoMode default vmNormal; { The @link(TFilterGraph) component } property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph; { Return the Handle where the video is displayed. } property VideoHandle: THandle read GetVideoHandle; { Video Mixer Renderer property editor. } property VMROptions: TVMROptions read FVMROptions write FVMROptions; { Set the full screen mode. } property FullScreen: boolean read FFullScreen write SetFullScreen default false; { Common properties & Events } {@exclude} property Color; {@exclude} property Visible: boolean read GetVisible write SetVisible default True; {@exclude} property ShowHint; {@exclude} property Anchors; {@exclude} property Canvas; {@exclude} property PopupMenu; {@exclude} property Align; {@exclude} property TabStop default True; {@exclude} property OnEnter; {@exclude} property OnExit; {@exclude} property OnKeyDown; {@exclude} property OnKeyPress; {@exclude} property OnKeyUp; {@exclude} property OnCanResize; {@exclude} property OnClick; {@exclude} property OnConstrainedResize; {@exclude} property OnDblClick; {@exclude} property OnMouseDown; {@exclude} property OnMouseMove; {@exclude} property OnMouseUp; {@exclude} property OnMouseWheel; {@exclude} property OnMouseWheelDown; {@exclude} property OnMouseWheelUp; {@exclude} property OnResize; end; //****************************************************************************** // // TFilterSampleGrabber declaration // description: Sample Grabber Wrapper Filter // //****************************************************************************** {@exclude} TSampleGrabber = class; { This class is designed make a snapshoot of Video or Audio Datas. WARNING: There is know problems with some DIVX movies, so use RGB32 Media Type instead of RBG24.} TSampleGrabber = class(TComponent, IFilter, ISampleGrabberCB) private FOnBuffer: TOnBuffer; FBaseFilter: IBaseFilter; FFilterGraph : TFilterGraph; FMediaType: TMediaType; BMPInfo : PBitmapInfo; FCriticalSection: TCriticalSection; function GetFilter: IBaseFilter; function GetName: string; procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0); procedure SetFilterGraph(AFilterGraph: TFilterGraph); function SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; stdcall; function BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: longint): HResult; stdcall; protected {@exclude} procedure Notification(AComponent: TComponent; Operation: TOperation); override; public { ISampleGrabber Interface to control the SampleGrabber Filter. The FilterGraph must be active.} SampleGrabber: ISampleGrabber; { The Input Pin. The FilterGraph must be active.} InPutPin : IPin; { The Output Pin. The FilterGraph must be active.} OutPutPin : IPin; { Constructor method. } constructor Create(AOwner: TComponent); override; { Destructor method. } destructor Destroy; override; { Configure the filter to cature the specified MediaType. This mΘthod disconnect the Input pin if connected. The FilterGraph must be active. } procedure UpdateMediaType; {@exclude} function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; { Configure the MediaType according to the Source MediaType to be compatible with the BMP format. if Source = nil then this method use the default value to set the resolution: 1..32. The MediaType is auto configured to RGB24.} procedure SetBMPCompatible(Source: PAMMediaType; SetDefault: cardinal); { This method read the buffer received in the OnBuffer event and paint the bitmap.} function GetBitmap(Bitmap: TBitmap; Buffer: Pointer; BufferLen: Integer): boolean; overload; { This method read the current buffer from the Sample Grabber Filter and paint the bitmap.} function GetBitmap(Bitmap: TBitmap): boolean; overload; { This method check if the Sample Grabber Filter is correctly registered on the system. } class function CheckFilter: boolean; published { Receive the Buffer from the Sample Grabber Filter. } property OnBuffer: TOnBuffer read FOnBuffer write FOnBuffer; { The filter must connected to a TFilterGraph component.} property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph; { The media type to capture. You can capture audio or video data. } property MediaType: TMediaType read FMediaType write FMediaType; end; // ***************************************************************************** // TFilter // ***************************************************************************** { This component is an easy way to add a specific filter to a filter graph. You can retrieve an interface using the <b>as</b> operator whith D6 :)} TFilter = class(TComponent, IFilter) private FFilterGraph : TFilterGraph; FBaseFilter: TBaseFilter; FFilter: IBaseFilter; function GetFilter: IBaseFilter; function GetName: string; procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0); procedure SetFilterGraph(AFilterGraph: TFilterGraph); protected {@exclude} procedure Notification(AComponent: TComponent; Operation: TOperation); override; public { Constructor method. } constructor Create(AOwner: TComponent); override; { Destructor method. } destructor Destroy; override; { Retrieve a filter interface. } function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; published { This is the Filter Editor .} property BaseFilter: TBaseFilter read FBaseFilter write FBaseFilter; { The filter must be connected to a TFilterGraph component.} property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph; end; // ***************************************************************************** // TASFWriter // ***************************************************************************** { This component is designed to create a ASF file or to stream over a network.} TASFWriter = class(TComponent, IFilter) private FFilterGraph : TFilterGraph; FFilter : IBaseFilter; FPort : Cardinal; FMaxUsers : Cardinal; FProfile : TWMPofiles8; FFileName : WideString; FAutoIndex : boolean; FMultiPass : boolean; FDontCompress: boolean; function GetProfile: TWMPofiles8; procedure SetProfile(profile: TWMPofiles8); function GetFileName: String; procedure SetFileName(FileName: String); function GetFilter: IBaseFilter; function GetName: string; procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0); procedure SetFilterGraph(AFilterGraph: TFilterGraph); protected {@exclude} procedure Notification(AComponent: TComponent; Operation: TOperation); override; public { Sink configuration. } WriterAdvanced2 : IWMWriterAdvanced2; { NetWork streaming configuration. } WriterNetworkSink : IWMWriterNetworkSink; { The Audio Input Pin. } AudioInput : IPin; { The Video Input Pin. } VideoInput : IPin; { Audio Input configuration. } AudioStreamConfig : IAMStreamConfig; { VideoInput configuration} VideoStreamConfig : IAMStreamConfig; { Destructor method. } constructor Create(AOwner: TComponent); override; destructor Destroy; override; {@exclude} function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; published { The filter must be connected to a TFilterGraph component.} property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph; { Windows media profile to use. } property Profile: TWMPofiles8 read GetProfile write SetProfile; { Destination file name to write the compressed file. } property FileName: String read GetFileName write SetFileName; { Port number to stream.} property Port: DWORD read FPort write FPort; { The max number of connections. } property MaxUsers: DWORD read FMaxUsers write FMaxUsers; property AutoIndex : boolean read FAutoIndex write FAutoIndex default True; property MultiPass : boolean read FMultiPass write FMultiPass default False; property DontCompress: boolean read FDontCompress write FDontCompress default False; end; // ***************************************************************************** // TDSTrackBar // ***************************************************************************** {@exclude} TTimerEvent = procedure(sender: TObject; CurrentPos, StopPos: Cardinal) of object ; { This control implement a seek bar for a media-player application. The seek bar is implemented as a TTrackbar control. } TDSTrackBar = class(TTrackBar, IEvent) private FFilterGraph: TFilterGraph; FMediaSeeking: IMediaSeeking; FWindowHandle: HWND; FInterval: Cardinal; FOnTimer: TTimerEvent; FEnabled: Boolean; FMouseDown: boolean; procedure UpdateTimer; procedure SetTimerEnabled(Value: Boolean); procedure SetInterval(Value: Cardinal); procedure SetOnTimer(Value: TTimerEvent); procedure SetFilterGraph(AFilterGraph: TFilterGraph); procedure GraphEvent(Event, Param1, Param2: integer); procedure ControlEvent(Event: TControlEvent; Param: integer = 0); procedure TimerWndProc(var Msg: TMessage); property TimerEnabled: Boolean read FEnabled write SetTimerEnabled; protected {@exclude} procedure Notification(AComponent: TComponent; Operation: TOperation); override; {@exclude} procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure Timer; dynamic; public { constructor method. } constructor Create(AOwner: TComponent); override; { destructor method. } destructor Destroy; override; published { Select the filtergraph to seek. } property FilterGraph: TFilterGraph read FFilterGraph Write SetFilterGraph; { Select the time interval in miliseconds. default = 1000 mls. } property TimerInterval: Cardinal read FInterval write SetInterval default 1000; { OnTimer event, you can retrieve the current and stop positions here. } property OnTimer: TTimerEvent read FOnTimer write SetOnTimer; end; { @exclude } TDSVideoWindowEx2 = class; // ***************************************************************************** // TColorControl // ***************************************************************************** { Set and Get ColorControls from DSVideoWindowEx's OverlayMixer. This is Hardware based so your graphic card has to support it. Check DSVideoWindowEx's Capabilities if your card support a given colorcontrol.} TColorControl = class(TPersistent) private FBrightness : Integer; FContrast : Integer; FHue : Integer; FSaturation : Integer; FSharpness : Integer; FGamma : Integer; FUtilColor : Boolean; FDefault : TDDColorControl; protected { Protected declarations } { @exclude } FOwner : TDSVideoWindowEx2; { @exclude } Procedure SetBrightness(Value : Integer); { @exclude } Procedure SetContrast(Value : Integer); { @exclude } procedure SetHue(Value : Integer); { @exclude } procedure SetSaturation(Value : Integer); { @exclude } procedure SetSharpness(Value : Integer); { @exclude } procedure SetGamma(Value : Integer); { @exclude } procedure SetUtilColor(Value : Boolean); { @exclude } function GetBrightness : Integer; { @exclude } function GetContrast : Integer; { @exclude } function GetHue : Integer; { @exclude } function GetSaturation : Integer; { @exclude } function GetSharpness : Integer; { @exclude } function GetGamma : Integer; { @exclude } function GetUtilColor : Boolean; { @exclude } Procedure ReadDefault; { @exclude } procedure UpdateColorControls; { @exclude } procedure GetColorControls; public { Public declarations } { @exclude } constructor Create(AOwner: TDSVideoWindowEx2); virtual; { Restore the colorcontrols to there (Default) values. Default is the value the colorcontrol hat, just after we initilized the overlay Mixer. } procedure RestoreDefault; Published { The Brightness property defines the luminance intensity, in IRE units, multiplied by 100. The possible range is from 0 to 10,000 with a default of 750.} property Brightness : Integer read GetBrightness write SetBrightness; { The Contrast property defines the relative difference between higher and lower luminance values, in IRE units, multiplied by 100. The possible range is from 0 to 20,000 with a default value of 10,000. } property Contrast : Integer read GetContrast write SetContrast; { The Hue property defines the phase relationship, in degrees, of the chrominance components. The possible range is from -180 to 180, with a default of 0.} property Hue : Integer read GetHue write SetHue; { The Saturation property defines the color intensity, in IRE units, multiplied by 100. The possible range is 0 to 20,000, with a default value of 10,000.} property Saturation : Integer read GetSaturation write SetSaturation; { The Sharpness property defines the sharpness, in arbitrary units, of an image. The possible range is 0 to 10, with a default value of 5.} property Sharpness : Integer read GetSharpness write SetSharpness; { The Gamma property defines the amount, in gamma units, of gamma correction applied to the luminance values. The possible range is from 1 to 500, with a default of 1.} property Gamma : Integer read GetGamma write SetGamma; { The ColorEnable property defines whether color is utilized or not. Color is used if this property is 1. Color is not used if this property is 0. The default value is 1.} property ColorEnable : Boolean read GetUtilColor write SetUtilColor; end; // ***************************************************************************** // TDSVideoWindowEx2Caps // ***************************************************************************** { Check capability of DSVideoWindowEx. } TDSVideoWindowEx2Caps = class(TPersistent) protected { Protected declarations } Owner : TDSVideoWindowEx2; function GetCanOverlay : Boolean; function GetCanControlBrigtness : Boolean; function GetCanControlContrast : Boolean; function GetCanControlHue : Boolean; function GetCanControlSaturation : Boolean; function GetCanControlSharpness : Boolean; function GetCanControlGamma : Boolean; function GetCanControlUtilizedColor : Boolean; public { Public declarations } { @exclude } constructor Create(AOwner: TDSVideoWindowEx2); virtual; published { if CanOverlayGraphics return true, you draw on DSVideoWindowEx's canvas and the graphic will bee ontop of the Video.} Property CanOverlayGraphic : Boolean read GetCanOverlay; { Repport if you can control Brightness on the video overlay } Property CanControlBrigtness : Boolean read GetCanControlBrigtness; { Repport if you can control Contrast on the video overlay } Property CanControlContrast : Boolean read GetCanControlContrast; { Repport if you can control Hue on the video overlay } Property CanControlHue : Boolean read GetCanControlHue; { Repport if you can control Saturation on the video overlay } Property CanControlSaturation : Boolean read GetCanControlSaturation; { Repport if you can control Sharpness on the video overlay } Property CanControlSharpness : Boolean read GetCanControlSharpness; { Repport if you can control Gamma on the video overlay } Property CanControlGamma : Boolean read GetCanControlGamma; { Repport if you can control ColorEnabled on the video overlay } Property CanControlColorEnabled : Boolean read GetCanControlUtilizedColor; end; // ***************************************************************************** // TOverlayCallback // ***************************************************************************** { @exclude } TOverlayCallback = class(TInterfacedObject, IDDrawExclModeVideoCallBack) AOwner : TObject; constructor Create(Owner : TObject); virtual; function OnUpdateOverlay(bBefore: BOOL; dwFlags: DWORD; bOldVisible: BOOL; var prcOldSrc, prcOldDest: TRECT; bNewVisible: BOOL; var prcNewSrc, prcNewDest: TRECT): HRESULT; stdcall; function OnUpdateColorKey(var pKey: TCOLORKEY; dwColor: DWORD): HRESULT; stdcall; function OnUpdateSize(dwWidth, dwHeight, dwARWidth, dwARHeight: DWORD): HRESULT; stdcall; end; // ***************************************************************************** // TDSVideoWindowEx2 // ***************************************************************************** { @exclude } TRatioModes = (rmStretched, rmLetterBox, rmCrop); { @exclude } TOverlayVisibleEvent = procedure (Sender: TObject; Visible : Boolean) of object; { @exclude } TCursorVisibleEvent = procedure (Sender: TObject; Visible : Boolean) of object; { A alternative to the regular Video Renderer (TVideoWindow), that give a easy way to overlay graphics onto your video in your application. } TDSVideoWindowEx2 = class(TCustomControl, IFilter, IEvent) private FVideoWindow : IVideoWindow; FFilterGraph : TFilterGraph; FBaseFilter : IBaseFilter; FOverlayMixer : IBaseFilter; FVideoRenderer : IBaseFilter; FDDXM : IDDrawExclModeVideo; FFullScreen : Boolean; FTopMost : Boolean; FColorKey : TColor; FWindowStyle : LongWord; FWindowStyleEx : LongWord; FVideoRect : TRect; FOnPaint : TNotifyEvent; FOnColorKey : TNotifyEvent; FOnCursorVisible : TCursorVisibleEvent; FOnOverlay : TOverlayVisibleEvent; FColorControl : TColorControl; FCaps : TDSVideoWindowEx2Caps; FZoom : Integer; FAspectMode : TRatioModes; FNoScreenSaver : Boolean; FIdleCursor : Integer; FMonitor : TMonitor; FFullscreenControl : TForm; GraphWasUpdatet : Boolean; FOldParent : TWinControl; OverlayCallback : TOverlayCallback; GraphBuildOK : Boolean; FVideoWindowHandle : HWND; LMousePos : TPoint; LCursorMov : DWord; RememberCursor : TCursor; IsHidden : Bool; FOverlayVisible : Boolean; OldDesktopColor : Longint; OldDesktopPic : String; FDesktopPlay : Boolean; procedure NotifyFilter(operation: TFilterOperation; Param: integer = 0); procedure GraphEvent(Event, Param1, Param2: integer); function GetName: string; procedure ControlEvent(Event: TControlEvent; Param: integer = 0); procedure SetFilterGraph(AFilterGraph: TFilterGraph); procedure SetTopMost(TopMost: boolean); procedure SetZoom(Value : Integer); function UpdateGraph : HResult; function GetVideoInfo : HResult; procedure SetAspectMode(Value : TRatioModes); procedure FullScreenCloseQuery(Sender: TObject; var CanClose: Boolean); procedure SetVideoZOrder; protected {@exclude} function GetFilter: IBaseFilter; {@exclude} procedure resize; override; {@exclude} procedure Loaded; override; {@exclude} procedure Notification(AComponent: TComponent; Operation: TOperation); override; {@exclude} procedure WndProc(var Message: TMessage); override; {@exclude} procedure Paint; override; {@exclude} procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; {@exclude} procedure MyIdleHandler(Sender: TObject; var Done: Boolean); {@exclude} procedure RefreshVideoWindow; public { constructor method. } constructor Create(AOwner: TComponent); override; { destructor method. } destructor Destroy; override; {@exclude} function QueryInterface(const IID: TGUID; out Obj): HResult; override; stdcall; { Clear the graphic ontop of DSVideoWindowEx. } procedure ClearBack; { Use your Desktop as the Video renderer. The video will display as a "wallpaper" on your Desktop } procedure StartDesktopPlayback; overload; { Use your Desktop as the Video renderer. The video will display as a "wallpaper" on your Desktop on the specifyed monitor} procedure StartDesktopPlayBack(OnMonitor : TMonitor); overload; { Return to normal window playback from Fullscreen or Desktop mode. } procedure NormalPlayback; { Start playback in fullscreen } procedure StartFullScreen; overload; { Start playback in fullscreen on specifyed Monitor} procedure StartFullScreen(OnMonitor : TMonitor); overload; { repporting if you are currently playing in fullscreen. } property FullScreen: boolean read FFullScreen; { repporting if you are currently playing on the Desktop. } property DesktopPlayback : Boolean Read FDesktopPlay; { @inherited } property Canvas; { The Colorkey is the color that the Overlay Mixer Filter used by DSVideoWindowEx sees as transparent, when you draw ontop of the movie always set the canvasÆs brush color to this color or set the style to bsclear. Note: The colors returned through this method vary depending on the current display mode. if the colors are 8-bit palettized, they will be bright system colors (such as magenta). if the display is in a true-color mode, they will be shades of black. } property ColorKey : TColor read FColorKey; { @link(TDSVideoWindowEx2Caps) } property Capabilities : TDSVideoWindowEx2Caps read FCaps; { Check this property to see if the overlay is visible when you draw on DSVideoWindowEx's canvas, if it is visible you should set your brush color to the same as the VideoColor and if not set your brush to the same color as DSVideoWindowEx color. } property OverlayVisible : Boolean read FOverlayVisible; published { The AspectRatio property sets the aspect ratio correction mode for window resizing. rmSTRETCHED : No aspect ratio correction. rmLETTERBOX : Put the video in letterbox format. Paint background color in the excess region so the video is not distorted. rmCROP : Crop the video to the correct aspect ratio. } property AspectRatio : TRatioModes read FAspectMode write SetAspectMode; { Set the amounts of milliseconds befor the cursor is hidden, if it is not moved. Setting the value to 0 will disable this feature. } property AutoHideCursor : Integer read FIdleCursor write FIdleCursor; { Specify a Zoom factor from 0 to 99 procent. } property DigitalZoom : Integer read FZoom write SetZoom; { The @link(TFilterGraph) component } property FilterGraph: TFilterGraph read FFilterGraph write SetFilterGraph; { Select if the VideoWindow it topmost or not. } property FullScreenTopMost: boolean read FTopMost write SetTopMost default false; { Event to tell the main application that the Colorkey has changed. Note: if you have controls placed ontop of your VideoWindow that need to act as transparent, set there color to the same as the Colorkey.} property OnColorKeyChanged: TNotifyEvent read FOnColorKey write FOnColorKey; { @link(TColorControl) } property ColorControl : TColorControl read FColorControl write FColorControl; { Setting this to true will prevent the screen to go into screensaver or powerdown. } property NoScreenSaver : Boolean read FNoScreenSaver write FNoScreenSaver; { This event accure when the Visible state of the overlay changes Note: Most used to hide the video in the player window when going to DesktopPlayback. } property OnOverlayVisible : TOverlayVisibleEvent read FOnOverlay write FOnOverlay; property OnPaint : TNotifyevent read FOnPaint Write FOnPaint; { This event accure when the cursor change from showing to hiding or from hiding to showing. } property OnCursorShowHide : TCursorVisibleEvent read FOnCursorVisible write FOnCursorVisible; property Color; {@exclude} property Visible; {@exclude} property ShowHint; {@exclude} property Anchors; {@exclude} property PopupMenu; {@exclude} property Align; {@exclude} property TabStop default True; {@exclude} property OnEnter; {@exclude} property OnExit; {@exclude} property OnKeyDown; {@exclude} property OnKeyPress; {@exclude} property OnKeyUp; {@exclude} property OnCanResize; {@exclude} property OnClick; {@exclude} property OnConstrainedResize; {@exclude} property OnDblClick; {@exclude} property OnMouseDown; {@exclude} property OnMouseMove; {@exclude} property OnMouseUp; {@exclude} property OnMouseWheel; {@exclude} property OnMouseWheelDown; {@exclude} property OnMouseWheelUp; {@exclude} property OnResize; end; //////////////////////////////////////////////////////////////////////////////// // // TVMRBitmap Class // //////////////////////////////////////////////////////////////////////////////// type { vmrbDisable: Disable the alpha bitmap. vmrbSrcColorKey: Enable ColorKey. vmrbSrcRect: Indicates that the Dest property is valid and specifies a sub-rectangle of the original image to be blended. } TVMRBitmapOption = ( vmrbDisable, vmrbSrcColorKey, vmrbSrcRect ); TVMRBitmapOptions = set of TVMRBitmapOption; TVMRBitmap = class private FVideoWindow: TVideoWindow; FCanvas: TCanvas; FVMRALPHABITMAP: TVMR9ALPHABITMAP; FOptions: TVMRBitmapOptions; FBMPOld: HBITMAP; procedure SetOptions(Options: TVMRBitmapOptions); procedure ResetBitmap; procedure SetAlpha(const Value: Single); procedure SetColorKey(const Value: COLORREF); procedure SetDest(const Value: TVMR9NormalizedRect); procedure SetDestBottom(const Value: Single); procedure SetDestLeft(const Value: Single); procedure SetDestRight(const Value: Single); procedure SetDestTop(const Value: Single); procedure SetSource(const Value: TRect); function GetAlpha: Single; function GetColorKey: COLORREF; function GetDest: TVMR9NormalizedRect; function GetDestBottom: Single; function GetDestLeft: Single; function GetDestRight: Single; function GetDestTop: Single; function GetSource: TRect; public // Contructor, set the video Window where the bitmat must be paint. constructor Create(VideoWindow: TVideoWindow); // Cleanup destructor Destroy; override; // Load a Bitmap from a TBitmap class. procedure LoadBitmap(Bitmap: TBitmap); // Initialize with an empty bitmap. procedure LoadEmptyBitmap(Width, Height: Integer; PixelFormat: TPixelFormat; Color: TColor); // Draw the bitmap to the Video Window. procedure Draw; // Draw the bitmap on a particular position. procedure DrawTo(Left, Top, Right, Bottom, Alpha: Single; doUpdate: boolean = false); // update the video window with the current bitmap procedure Update; // Uses this property to draw on the internal bitmap. property Canvas: TCanvas read FCanvas write FCanvas; // Change Alpha Blending property Alpha: Single read GetAlpha write SetAlpha; // set the source rectangle property Source: TRect read GetSource write SetSource; // Destination Left property DestLeft : Single read GetDestLeft write SetDestLeft; // Destination Top property DestTop : Single read GetDestTop write SetDestTop; // Destination Right property DestRight : Single read GetDestRight write SetDestRight; // Destination Bottom property DestBottom : Single read GetDestBottom write SetDestBottom; // Destination property Dest: TVMR9NormalizedRect read GetDest write SetDest; // Set the color key for transparency. property ColorKey: COLORREF read GetColorKey write SetColorKey; // VMR Bitmap Options. property Options: TVMRBitmapOptions read FOptions write SetOptions; end; implementation uses ComObj; // ***************************************************************************** // TFilterGraph // ***************************************************************************** constructor TFilterGraph.Create(AOwner: TComponent); begin inherited Create(AOwner); FHandle := AllocateHWnd(WndProc); end; destructor TFilterGraph.Destroy; begin SetActive(False); DeallocateHWnd(FHandle); inherited Destroy; end; procedure TFilterGraph.SetGraphMode(Mode: TGraphMode); var WasActive: boolean; begin if FMode = Mode then exit; WasActive := Active; Active := False; FMode := Mode; Active := WasActive; end; procedure TFilterGraph.SetActive(Activate: boolean); begin if Activate = FActive then exit; case Activate of true : begin case FMode of gmNormal : CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IFilterGraph2, FFilterGraph); gmCapture: begin CoCreateInstance(CLSID_CaptureGraphBuilder2, nil, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, FCaptureGraph); CoCreateInstance(CLSID_FilterGraph, nil, CLSCTX_INPROC_SERVER, IID_IFilterGraph2, FFilterGraph); FCaptureGraph.SetFiltergraph(IGraphBuilder(FFilterGraph)); end; gmDVD : begin CoCreateInstance(CLSID_DvdGraphBuilder, nil, CLSCTX_INPROC_SERVER, IID_IDvdGraphBuilder, FDvdGraph); FDvdGraph.GetFiltergraph(IGraphBuilder(FFilterGraph)); end; end; FActive := true; // Events if Succeeded(QueryInterface(IMediaEventEx, FMediaEventEx)) then begin FMediaEventEx.SetNotifyFlags(0); // enable events notification FMediaEventEx.SetNotifyWindow(FHandle,WM_GRAPHNOTIFY,ULONG(FMediaEventEx)); end; // Remote Object Table GraphEdit := FGraphEdit; // Add the Filter Graph to the ROT if needed. // Log File SetLogFile(FLogFileName); // Load Filters AddOwnFilters; // Notify Controlers if assigned(FOnActivate) then FOnActivate(self); ControlEvents(ceActive, 1); end; false: begin ControlEvents(ceActive, 0); ClearOwnFilters; if FMediaEventEx <> nil then begin FMediaEventEx.SetNotifyFlags(AM_MEDIAEVENT_NONOTIFY); // disable events notification FMediaEventEx := nil; end; if FGraphEditID <> 0 then begin RemoveGraphFromRot(FGraphEditID); FGraphEditID := 0; end; FFilterGraph.SetLogFile(0); if Assigned(FLogFile) then FreeAndNil(FLogFile); FFilterGraph := nil; FCaptureGraph := nil; FDVDGraph := nil; FActive := false; end; end; end; procedure TFilterGraph.Loaded; begin if AutoCreate and (not (csDesigning in ComponentState)) then SetActive(True); inherited Loaded; end; procedure TFilterGraph.WndProc(var Msg: TMessage); begin with Msg do if Msg = WM_GRAPHNOTIFY then try HandleEvents; except Application.HandleException(Self); end else Result := DefWindowProc(FHandle, Msg, wParam, lParam); end; procedure TFilterGraph.HandleEvents; var hr: HRESULT; Event, Param1, Param2: Integer; begin if assigned(FMediaEventEx) then begin hr := FMediaEventEx.GetEvent(Event, Param1, Param2, 0); while (hr = S_OK) do begin DoEvent(Event, Param1, Param2); FMediaEventEx.FreeEventParams(Event, Param1, Param2); hr := FMediaEventEx.GetEvent(Event, Param1, Param2, 0); end; end; end; procedure TFilterGraph.DoEvent(Event, Param1, Param2: Integer); type TVideoSize = record Width : WORD; Height: WORD; end; var lcid : cardinal; achLang : array[0..MAX_PATH] of Char; tc : TDVDTimeCode; frate : integer; hmsftc : TDVDHMSFTimeCode; DVDInfo2: IDVDInfo2; begin GraphEvents(Event, Param1, Param2); if assigned(FOnDSEvent) then FOnDSEvent(self, Event, Param1, Param2); case Event of EC_BUFFERING_DATA : if assigned(FOnGraphBufferingData) then FOnGraphBufferingData(self,(Param1 = 1)); EC_CLOCK_CHANGED : if assigned(FOnGraphClockChanged) then FOnGraphClockChanged(self); EC_COMPLETE : if assigned(FOnGraphComplete) then FOnGraphComplete(self, Param1, IBaseFilter(Param2)); EC_DEVICE_LOST : if assigned(FOnGraphDeviceLost) then FOnGraphDeviceLost(self,IUnKnown(Param1),(Param2 = 1)); EC_END_OF_SEGMENT : if assigned(FOnGraphEndOfSegment) then FOnGraphEndOfSegment(self, PReferenceTime(Param1)^, Param2); EC_ERROR_STILLPLAYING : if assigned(FOnGraphErrorStillPlaying) then FOnGraphErrorStillPlaying(self, Param1); EC_ERRORABORT : if assigned(FOnGraphErrorAbort) then FOnGraphErrorAbort(self, Param1); EC_FULLSCREEN_LOST : if assigned(FOnGraphFullscreenLost) then FOnGraphFullscreenLost(self, IBaseFilter(Param2)); EC_GRAPH_CHANGED : if assigned(FOnGraphChanged) then FOnGraphChanged(self); EC_OLE_EVENT : if assigned(FOnGraphOleEvent) then FOnGraphOleEvent(self, WideString(Param1), WideString(Param2)); EC_OPENING_FILE : if assigned(FOnGraphOpeningFile) then FOnGraphOpeningFile(self, (Param1 = 1)); EC_PALETTE_CHANGED : if assigned(FOnGraphPaletteChanged) then FOnGraphPaletteChanged(self); EC_PAUSED : if assigned(FOnGraphPaused) then FOnGraphPaused(self, Param1); EC_QUALITY_CHANGE : if assigned(FOnGraphQualityChange) then FOnGraphQualityChange(self); EC_SNDDEV_IN_ERROR : if assigned(FOnGraphSNDDevInError) then FOnGraphSNDDevInError(self, TSndDevErr(Param1), Param2); EC_SNDDEV_OUT_ERROR : if assigned(FOnGraphSNDDevOutError) then FOnGraphSNDDevOutError(self, TSndDevErr(Param1), Param2); EC_STEP_COMPLETE : if assigned(FOnGraphStepComplete) then FOnGraphStepComplete(self); EC_STREAM_CONTROL_STARTED : if assigned(FOnGraphStreamControlStarted) then FOnGraphStreamControlStarted(self, IPin(Param1), Param2); EC_STREAM_CONTROL_STOPPED : if assigned(FOnGraphStreamControlStopped) then FOnGraphStreamControlStopped(self, IPin(Param1), Param2); EC_STREAM_ERROR_STILLPLAYING : if assigned(FOnGraphStreamErrorStillPlaying) then FOnGraphStreamErrorStillPlaying(self, Param1, Param2); EC_STREAM_ERROR_STOPPED : if assigned(FOnGraphStreamErrorStopped) then FOnGraphStreamErrorStopped(self, Param1, Param2); EC_USERABORT : if assigned(FOnGraphUserAbort) then FOnGraphUserAbort(self); EC_VIDEO_SIZE_CHANGED : if assigned(FOnGraphVideoSizeChanged) then FOnGraphVideoSizeChanged(self, TVideoSize(Param1).Width, TVideoSize(Param1).Height); EC_TIMECODE_AVAILABLE : if assigned(FOnGraphTimeCodeAvailable) then FOnGraphTimeCodeAvailable(self,IBaseFilter(Param1), Param2); EC_EXTDEVICE_MODE_CHANGE : if assigned(FOnGraphEXTDeviceModeChange) then FOnGraphEXTDeviceModeChange(self, Param1, Param2); EC_CLOCK_UNSET : if assigned(FOnGraphClockUnset) then FOnGraphClockUnset(self); EC_VMR_RENDERDEVICE_SET : if assigned(FOnGraphVMRRenderDevice) then FOnGraphVMRRenderDevice(self, TVMRRenderDevice(Param1)) ; EC_DVD_ANGLE_CHANGE : if Assigned(FOnDVDAngleChange) then FOnDVDAngleChange(self,Param1,Param2); EC_DVD_AUDIO_STREAM_CHANGE : begin if Assigned(FOnDVDAudioStreamChange) then if Succeeded(QueryInterFace(IDVDInfo2,DVDInfo2)) then begin CheckDSError(DvdInfo2.GetAudioLanguage(Param1, lcid)); GetLocaleInfo(lcid, LOCALE_SENGLANGUAGE, achLang, MAX_PATH); FOnDVDAudioStreamChange(self, Param1, lcid, string(achLang)); DVDInfo2 := nil; end; end; EC_DVD_BUTTON_CHANGE : if Assigned(FOnDVDButtonChange) then FOnDVDButtonChange(self, Param1, Param2); EC_DVD_CHAPTER_AUTOSTOP : if Assigned(FOnDVDChapterAutoStop) then FOnDVDChapterAutoStop(self); EC_DVD_CHAPTER_START : if Assigned(FOnDVDChapterStart) then FOnDVDChapterStart(self, Param1); EC_DVD_CURRENT_TIME : begin if Assigned(FOnDVDCurrentTime) then begin tc := IntToTimeCode(Param1); case tc.FrameRateCode of 1 : frate := 25; 3 : frate := 30; else frate := 0; end; FOnDVDCurrentTime(self,tc.Hours1+tc.Hours10*10,tc.Minutes1+tc.Minutes10*10,tc.Seconds1+tc.Seconds10*10,tc.Frames1+tc.Frames10*10,frate); end; end; EC_DVD_DOMAIN_CHANGE : begin case Param1 of 1 : if Assigned(FOnDVDDomainFirstPlay) then FOnDVDDomainFirstPlay(self); 2 : if Assigned(FOnDVDDomainVideoManagerMenu) then FOnDVDDomainVideoManagerMenu(self); 3 : if Assigned(FOnDVDDomainVideoTitleSetMenu) then FOnDVDDomainVideoTitleSetMenu(self); 4 : if Assigned(FOnDVDDomainTitle) then FOnDVDDomainTitle(self); 5 : if Assigned(FOnDVDDomainStop) then FOnDVDDomainStop(self); end; end; EC_DVD_ERROR : begin case Param1 of 1 : if Assigned(FOnDVDErrorUnexpected) then FOnDVDErrorUnexpected(self); 2 : if Assigned(FOnDVDErrorCopyProtectFail) then FOnDVDErrorCopyProtectFail(self); 3 : if Assigned(FOnDVDErrorInvalidDVD1_0Disc) then FOnDVDErrorInvalidDVD1_0Disc(self); 4 : if Assigned(FOnDVDErrorInvalidDiscRegion) then FOnDVDErrorInvalidDiscRegion(self); 5 : if Assigned(FOnDVDErrorLowParentalLevel) then FOnDVDErrorLowParentalLevel(self); 6 : if Assigned(FOnDVDErrorMacrovisionFail) then FOnDVDErrorMacrovisionFail(self); 7 : if Assigned(FOnDVDErrorIncompatibleSystemAndDecoderRegions) then FOnDVDErrorIncompatibleSystemAndDecoderRegions(self); 8 : if Assigned(FOnDVDErrorIncompatibleDiscAndDecoderRegions) then FOnDVDErrorIncompatibleDiscAndDecoderRegions(self); end; end; EC_DVD_NO_FP_PGC : if Assigned(FOnDVDNoFP_PGC) then FOnDVDNoFP_PGC(self); EC_DVD_STILL_OFF : if Assigned(FOnDVDStillOff) then FOnDVDStillOff(self); EC_DVD_STILL_ON : if Assigned(FOnDVDStillOn) then FOnDVDStillOn(self,(Param1 = 1), Param2); EC_DVD_SUBPICTURE_STREAM_CHANGE: begin if Assigned(FOnDVDSubpictureStreamChange) then begin DvdInfo2.GetSubpictureLanguage(Param1,lcid); GetLocaleInfo(lcid,LOCALE_SENGLANGUAGE,achLang,MAX_PATH); FOnDVDSubpictureStreamChange(self,Param1,lcid,string(achLang)); end; end; EC_DVD_TITLE_CHANGE : if Assigned(FOnDVDTitleChange) then FOnDVDTitleChange(self,Param1); EC_DVD_VALID_UOPS_CHANGE : if Assigned(FOnDVDValidUOPSChange) then FOnDVDValidUOPSChange(self, Param1); EC_DVD_WARNING : begin case Param1 of 1 : if Assigned(FOnDVDWarningInvalidDVD1_0Disc) then FOnDVDWarningInvalidDVD1_0Disc(self); 2 : if Assigned(FOnDVDWarningFormatNotSupported) then FOnDVDWarningFormatNotSupported(self); 3 : if Assigned(FOnDVDWarningIllegalNavCommand) then FOnDVDWarningIllegalNavCommand(self); 4 : if Assigned(FOnDVDWarningOpen) then FOnDVDWarningOpen(self); 5 : if Assigned(FOnDVDWarningSeek) then FOnDVDWarningSeek(self); 6 : if Assigned(FOnDVDWarningRead) then FOnDVDWarningRead(self); end; end; EC_DVD_PLAYBACK_RATE_CHANGE : if Assigned(FOnDVDPlaybackRateChange) then FOnDVDPlaybackRateChange(self, Param1/10000); EC_DVD_PARENTAL_LEVEL_CHANGE : if Assigned(FOnDVDParentalLevelChange) then FOnDVDParentalLevelChange(self,Param1); EC_DVD_PLAYBACK_STOPPED : if Assigned(FOnDVDPlaybackStopped) then FOnDVDPlaybackStopped(self); EC_DVD_ANGLES_AVAILABLE : if Assigned(FOnDVDAnglesAvailable) then FOnDVDAnglesAvailable(self,(Param1 = 1)); EC_DVD_PLAYPERIOD_AUTOSTOP : if Assigned(FOnDVDPlayPeriodAutoStop) then FOnDVDPlayPeriodAutoStop(self); EC_DVD_BUTTON_AUTO_ACTIVATED : if Assigned(FOnDVDButtonAutoActivated) then FOnDVDButtonAutoActivated(self,Param1); EC_DVD_CMD_START : if Assigned(FOnDVDCMDStart) then FOnDVDCMDStart(self,Param1); EC_DVD_CMD_END : if Assigned(FOnDVDCMDEnd) then FOnDVDCMDEnd(self,Param1); EC_DVD_DISC_EJECTED : if Assigned(FOnDVDDiscEjected) then FOnDVDDiscEjected(self); EC_DVD_DISC_INSERTED : if Assigned(FOnDVDDiscInserted) then FOnDVDDiscInserted(self); EC_DVD_CURRENT_HMSF_TIME : begin if assigned(FOnDVDCurrentHMSFTime) then begin hmsftc := TDVDHMSFTimeCode(param1); tc := IntToTimeCode(Param2); FOnDVDCurrentHMSFTime(self,hmsftc,tc); end; end; EC_DVD_KARAOKE_MODE : if assigned(FOnDVDKaraokeMode) then FOnDVDKaraokeMode(self,BOOL(Param1)); end; end; function TFilterGraph.QueryInterface(const IID: TGUID; out Obj): HResult; begin result := inherited QueryInterface(IID, Obj); if (not Succeeded(result)) and Active then case FMode of gmNormal : result := FFilterGraph.QueryInterface(IID, Obj); gmCapture : begin result := FCaptureGraph.QueryInterface(IID, Obj); if not Succeeded(result) then result := FFilterGraph.QueryInterface(IID, Obj); end; gmDVD : begin result := FDvdGraph.QueryInterface(IID, Obj); if not Succeeded(result) then result := FDvdGraph.GetDvdInterface(IID, Obj); if not Succeeded(result) then result := FFilterGraph.QueryInterface(IID, Obj); end; end; end; procedure TFilterGraph.SetGraphEdit(enable: boolean); begin case enable of true : begin if FGraphEditID = 0 then if Active then AddGraphToRot(IFilterGraph2(FFilterGraph) , FGraphEditID); end; false : begin if FGraphEditID <> 0 then begin RemoveGraphFromRot(FGraphEditID); FGraphEditID := 0; end; end; end; FGraphEdit := enable; end; procedure TFilterGraph.InsertFilter(AFilter: IFilter); var FilterName: WideString; begin if FFilters = nil then FFilters := TInterfaceList.Create; FFilters.Add(AFilter); if active then begin AFilter.NotifyFilter(foAdding); FilterName := AFilter.GetName; FFilterGraph.AddFilter(AFilter.GetFilter, PWideChar(FilterName)); AFilter.NotifyFilter(foAdded); end; end; procedure TFilterGraph.RemoveFilter(AFilter: IFilter); begin FFilters.Remove(AFilter); if active then begin AFilter.NotifyFilter(foRemoving); FFilterGraph.RemoveFilter(AFilter.GetFilter); AFilter.NotifyFilter(foRemoved); end; if FFilters.Count = 0 then FreeAndNil(FFilters); end; procedure TFilterGraph.InsertEventNotifier(AEvent: IEvent); begin if FGraphEvents = nil then FGraphEvents := TInterFaceList.Create; FGraphEvents.Add(AEvent); end; procedure TFilterGraph.RemoveEventNotifier(AEvent: IEvent); begin if FGraphEvents <> nil then begin FGraphEvents.Remove(AEvent); if FGraphEvents.Count = 0 then FreeAndNil(FGraphEvents); end; end; procedure TFilterGraph.ClearOwnFilters; var i: integer; begin if Active and (FFilters <> nil) then for i := 0 to FFilters.Count - 1 do begin IFilter(FFilters.Items[i]).NotifyFilter(foRemoving); FFilterGraph.RemoveFilter(IFilter(FFilters.Items[i]).GetFilter); IFilter(FFilters.Items[i]).NotifyFilter(foRemoved); end; end; procedure TFilterGraph.AddOwnFilters; var i: integer; FilterName: WideString; begin if Active and (FFilters <> nil) then for i := 0 to FFilters.Count - 1 do begin IFilter(FFilters.Items[i]).NotifyFilter(foAdding); FilterName := IFilter(FFilters.Items[i]).GetName; FFilterGraph.AddFilter(IFilter(FFilters.Items[i]).GetFilter, PWideChar(FilterName)); IFilter(FFilters.Items[i]).NotifyFilter(foAdded); end; end; { procedure TFilterGraph.NotifyFilters(operation: TFilterOperation; Param: integer); var i: integer; begin if FFilters <> nil then for i := 0 to FFilters.Count - 1 do IFilter(FFilters.Items[i]).NotifyFilter(operation, Param); end; } procedure TFilterGraph.GraphEvents(Event, Param1, Param2: integer); var i: integer; begin if FGraphEvents <> nil then for i := 0 to FGraphEvents.Count - 1 do IEvent(FGraphEvents.Items[i]).GraphEvent(Event, Param1, Param2); end; procedure TFilterGraph.ControlEvents(Event: TControlEvent; Param: integer = 0); var i: integer; begin if FGraphEvents <> nil then for i := 0 to FGraphEvents.Count - 1 do IEvent(FGraphEvents.Items[i]).ControlEvent(Event, param); end; function TFilterGraph.Play: boolean; var MediaControl: IMediaControl; begin result := false; if Succeeded(QueryInterface(IMediaControl, MediaControl)) then begin ControlEvents(cePlay); result := Succeeded((CheckDSError(MediaControl.Run))); MediaControl := nil; end; end; function TFilterGraph.Pause: boolean; var MediaControl: IMediaControl; begin result := false; if Succeeded(QueryInterface(IMediaControl, MediaControl)) then begin ControlEvents(cePause); result := (CheckDSError(MediaControl.Pause) = S_OK); MediaControl := nil; end; end; function TFilterGraph.Stop: boolean; var MediaControl: IMediaControl; begin result := false; if Succeeded(QueryInterface(IMediaControl, MediaControl)) then begin ControlEvents(ceStop); result := (CheckDSError(MediaControl.Stop) = S_OK); MediaControl := nil; end; end; procedure TFilterGraph.SetLogFile(FileName: String); begin if Active then begin FFilterGraph.SetLogFile(0); if Assigned(FLogFile) then FreeAndNil(FLogFile); if FileName <> '' then try FLogFile := TFileStream.Create(FileName, fmCreate{$IFDEF VER140}, fmShareDenyNone{$ENDIF}); FFilterGraph.SetLogFile(FLogFile.Handle); except FFilterGraph.SetLogFile(0); if Assigned(FLogFile) then FreeAndNil(FLogFile); exit; end; end; FLogFileName := FileName; end; procedure TFilterGraph.DisconnectFilters; var FilterList: TFilterList; PinList: TPinList; BaseFilter: IBaseFilter; i, j: integer; begin if assigned(FFilterGraph) then begin FilterList:= TFilterList.Create(FFilterGraph); if FilterList.Count > 0 then for i := 0 to FilterList.Count - 1 do begin BaseFilter := FilterList.Items[i] as IBaseFilter; PinList := TPinList.Create(BaseFilter); if PinList.Count > 0 then for j := 0 to PinList.Count - 1 do CheckDSError(IPin(PinList.Items[j]).Disconnect); PinList.Free; BaseFilter := nil; end; FilterList.Free; end; end; procedure TFilterGraph.ClearGraph; var i: integer; FilterList: TFilterList; begin if Assigned(FFilterGraph) then begin Stop; DisconnectFilters; FilterList:= TFilterList.Create(FFilterGraph); if assigned(FFilters) then if FFilters.Count > 0 then for i := 0 to FFilters.count - 1 do FilterList.Remove(IFilter(FFilters.Items[i]).GetFilter); if FilterList.count > 0 then for i := 0 to FilterList.Count - 1 do CheckDSError(FFilterGraph.RemoveFilter(FilterList.Items[i])); FilterList.Free; end; end; function TFilterGraph.GetState: TGraphState; var AState: TFilterState; MediaControl: IMediaControl; begin result := gsUninitialized; if Succeeded(QueryInterface(IMediaControl, MediaControl)) then begin MediaControl.GetState(0,AState); case AState of State_Stopped : result := gsStopped; State_Paused : result := gsPaused; State_Running : result := gsPlaying; end; MediaControl := nil; end; end; function TFilterGraph.GetVolume: integer; var BasicAudio: IBasicAudio; AVolume: integer; begin result := 0; if Succeeded(QueryInterface(IBasicAudio, BasicAudio)) then begin BasicAudio.get_Volume(AVolume); result := AVolume + 10000; BasicAudio := nil; end; end; procedure TFilterGraph.SetVolume(Volume: Integer); var BasicAudio: IBasicAudio; begin if Succeeded(QueryInterface(IBasicAudio, BasicAudio)) then begin BasicAudio.put_Volume(Volume-10000); BasicAudio := nil; end; end; function TFilterGraph.GetBalance: integer; var BasicAudio: IBasicAudio; begin if Succeeded(QueryInterface(IBasicAudio, BasicAudio)) then begin BasicAudio.get_Balance(result); BasicAudio := nil; end; end; procedure TFilterGraph.SetBalance(Balance: integer); var BasicAudio: IBasicAudio; begin if Succeeded(QueryInterface(IBasicAudio, BasicAudio)) then begin BasicAudio.put_Balance(Balance); BasicAudio := nil; end; end; function TFilterGraph.GetSeekCaps: TSeekingCaps; var MediaSeeking: IMediaSeeking; Flags: Cardinal; begin result := []; if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then begin MediaSeeking.GetCapabilities(Flags); PByte(@Result)^ := Flags; MediaSeeking := nil; end; end; function TFilterGraph.RenderFile(FileName: WideString): HRESULT; begin result := S_FALSE; if assigned(FFilterGraph) then begin ControlEvents(ceFileRendering); result := CheckDSError(FFilterGraph.RenderFile(PWideChar(FileName), nil)); if Succeeded(result) then ControlEvents(ceFileRendered); end; end; { TODO -oHG : Add the audio rendering } function TFilterGraph.RenderFileEx(FileName: WideString): HRESULT; var SourceFilter: IBaseFilter; PinList: TPinList; i: Integer; begin result := S_FALSE; if assigned(FFilterGraph) then begin ControlEvents(ceFileRendering); CheckDSError(FFilterGraph.AddSourceFilter(PWideChar(FileName), PWideChar(FileName), SourceFilter)); PinList := TPinList.Create(SourceFilter); try for i := 0 to PinList.Count - 1 do begin CheckDSError(IFilterGraph2(FFilterGraph).RenderEx(PinList.Items[i], AM_RENDEREX_RENDERTOEXISTINGRENDERERS, nil)); end; finally PinList.Free; end; if Succeeded(result) then ControlEvents(ceFileRendered); end; end; function TFilterGraph.RenderDVD(out status: TAMDVDRenderStatus; FileName: WideString = ''; Mode: Integer = AM_DVD_HWDEC_PREFER): HRESULT; begin result := HRESULT(VFW_E_DVD_RENDERFAIL); if assigned(FDVDGraph) then begin ControlEvents(ceDVDRendering, Mode); if FileName <> '' then result := CheckDSError(FDVDGraph.RenderDvdVideoVolume(PWideChar(FileName), Mode, Status)) else result := CheckDSError(FDVDGraph.RenderDvdVideoVolume(nil, Mode, Status)); if result in [S_OK..S_FALSE] then ControlEvents(ceDVDRendered, Mode); end; end; procedure TFilterGraph.SetRate(Rate: double); var MediaSeeking: IMediaSeeking; begin if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then begin MediaSeeking.SetRate(Rate); MediaSeeking := nil; end; end; function TFilterGraph.GetRate: double; var MediaSeeking: IMediaSeeking; begin if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then begin MediaSeeking.GetRate(result); MediaSeeking := nil; end; end; function TFilterGraph.GetDuration: integer; var MediaSeeking: IMediaSeeking; RefTime: int64; begin if Succeeded(QueryInterface(IMediaSeeking, MediaSeeking)) then begin MediaSeeking.GetDuration(RefTime); result := RefTimeToMiliSec(RefTime); MediaSeeking := nil; end else result := 0; end; procedure TFilterGraph.DVDSaveBookmark(BookMarkFile: WideString); var DVDInfo2: IDVDInfo2; Bookmark: IDvdState; pStorage: IStorage; pStream : IStream; PersistStream : IPersistStream; begin if Active and (Mode = gmDVD) then if Succeeded(QueryInterface(IDVDInfo2, DVDInfo2)) then begin DVDInfo2.GetState(Bookmark); StgCreateDocfile(PWideChar(BookMarkFile), STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE, 0, pStorage); pStorage.CreateStream('BookMark', STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE, 0, 0, pStream); if Succeeded(Bookmark.QueryInterface(IID_IPersistStream,PersistStream)) then begin OleSaveToStream(PersistStream,pStream); PersistStream := nil; end else begin PersistStream := nil; DVDInfo2 := nil; exit; end; DVDInfo2 := nil; end; end; procedure TFilterGraph.DVDRestoreBookmark(BookMarkFile: WideString); var DVDControl2: IDvdControl2; pStorage : IStorage; pStream : IStream; pBookmark: IDvdState; hr : HRESULT; obj : IDVDCmd; begin if Succeeded(QueryInterface(IDvdControl2, DvdControl2)) then begin StgOpenStorage(PWideChar(BookMarkFile), nil, STGM_READ or STGM_SHARE_EXCLUSIVE, nil , 0, pStorage); pStorage.OpenStream('BookMark', nil, STGM_READ or STGM_SHARE_EXCLUSIVE, 0, pStream); OleLoadFromStream(pStream, IID_IDvdState, pBookmark); hr := CheckDSError(DVDControl2.SetState(pBookmark, DVD_CMD_FLAG_None, obj)); if not (failed(hr)) then begin obj.WaitForEnd; obj := nil; end; DvdControl2 := nil; end; end; //****************************************************************************** // TVMROptions //****************************************************************************** constructor TVMROptions.Create(AOwner: TVideoWindow); begin FPreferences := [vpForceMixer]; FStreams := 4; FOwner := AOwner; FMode := vmrWindowed; FKeepAspectRatio := True; end; procedure TVMROptions.SetStreams(Streams: cardinal); begin if Streams in [1..16] then FStreams := Streams else FStreams := 1; with FOwner do begin if (mode <> vmVMR) or (FilterGraph = nil) then exit; if not FilterGraph.Active then exit; // need to reconnect FilterGraph.RemoveFilter(FOwner); FilterGraph.InsertFilter(FOwner); end; end; procedure TVMROptions.SetPreferences(Preferences: TVMRPreferences); begin FPreferences := Preferences; with FOwner do begin if (mode <> vmVMR) or (FilterGraph = nil) then exit; if not FilterGraph.Active then exit; // need to reconnect FilterGraph.RemoveFilter(FOwner); FilterGraph.InsertFilter(FOwner); end; end; procedure TVMROptions.SetMode(AMode: TVMRVideoMode); begin FMode := AMode; with FOwner do begin if (mode <> vmVMR) or (FilterGraph = nil) then exit; if not FilterGraph.Active then exit; // need to reconnect FilterGraph.RemoveFilter(FOwner); FilterGraph.InsertFilter(FOwner); end; end; procedure TVMROptions.SetKeepAspectRatio(Keep: boolean); var AspectRatioControl: IVMRAspectRatioControl9; begin FKeepAspectRatio := Keep; case Mode of vmrWindowed, vmrWindowless: begin if Succeeded(FOwner.QueryInterface(IVMRAspectRatioControl9, AspectRatioControl)) then case Keep of true: CheckDSError(AspectRatioControl.SetAspectRatioMode(VMR_ARMODE_LETTER_BOX)); false: CheckDSError(AspectRatioControl.SetAspectRatioMode(VMR_ARMODE_NONE)); end; end; vmrRenderless: {TODO}; end; end; //****************************************************************************** // TVideoWindow //****************************************************************************** constructor TVideoWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); FVMROptions:= TVMROptions.Create(self); ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csDoubleClicks, csReflector]; TabStop := true; Height := 120; Width := 160; color := $000000; FIsFullScreen := false; FKeepAspectRatio := True; end; destructor TVideoWindow.Destroy; begin FVMROptions.Free; FilterGraph := nil; inherited destroy; end; procedure TVideoWindow.SetVideoMode(AMode: TVideoMode); begin if (AMode = vmVMR) and (not CheckVMR) then FMode := vmNormal else FMode := AMode; if FilterGraph = nil then exit; if not FilterGraph.Active then exit; // need to reconnect FilterGraph.RemoveFilter(self); FilterGraph.InsertFilter(self); end; procedure TVideoWindow.Loaded; begin inherited Loaded; FWindowStyle := GetWindowLong(Handle, GWL_STYLE); FWindowStyleEx := GetWindowLong(Handle, GWL_EXSTYLE); end; procedure TVideoWindow.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if ((AComponent = FFilterGraph) and (Operation = opRemove)) then FFilterGraph := nil; end; procedure TVideoWindow.SetFilterGraph(AFilterGraph: TFilterGraph); begin if AFilterGraph = FFilterGraph then exit; if FFilterGraph <> nil then begin FFilterGraph.RemoveFilter(self); FFilterGraph.RemoveEventNotifier(self); end; if AFilterGraph <> nil then begin AFilterGraph.InsertFilter(self); AFilterGraph.InsertEventNotifier(self); end; FFilterGraph := AFilterGraph; end; function TVideoWindow.GetFilter: IBaseFilter; begin result := FBaseFilter; end; function TVideoWindow.GetName: string; begin result := name; end; procedure TVideoWindow.NotifyFilter(operation: TFilterOperation; Param: integer); var EnumPins: TPinList; VMRFilterConfig: IVMRFilterConfig9; VMRSurfaceAllocatorNotify: IVMRSurfaceAllocatorNotify9; VMRSurfaceAllocator: IVMRSurfaceAllocator9; MyPrefs: TVMRPreferences; APrefs: cardinal; i: integer; CW: Word; hr: HResult; DSPackException: EDSPackException; procedure UpdatePreferences; begin // VMR9 preferences MyPrefs := FVMROptions.FPreferences - [vpForceMixer]; CheckDSError(VMRFilterConfig.SetRenderingPrefs(PByte(@MyPrefs)^)); APrefs := 0; CheckDSError(VMRFilterConfig.GetRenderingPrefs(APrefs)); if (vpForceMixer in FVMROptions.FPreferences) then FVMROptions.FPreferences := PVMRPreferences(@APrefs)^ + [vpForceMixer] else FVMROptions.FPreferences := PVMRPreferences(@APrefs)^; end; begin case operation of foAdding: begin case mode of vmVMR : begin CW := Get8087CW; try CoCreateInstance(CLSID_VideoMixingRenderer9, nil, CLSCTX_INPROC, IID_IBaseFilter ,FBaseFilter); FBaseFilter.QueryInterface(IVMRFilterConfig9, VMRFilterConfig); case FVMROptions.Mode of vmrWindowed: CheckDSError(VMRFilterConfig.SetRenderingMode(VMR9Mode_Windowed)); vmrWindowless: CheckDSError(VMRFilterConfig.SetRenderingMode(VMR9Mode_Windowless)); vmrRenderless: begin if (FAllocatorClass = nil) then raise EDSPackException.Create('Allocator class not set.'); FCurrentAllocator := FAllocatorClass.Create(hr, Handle); if failed(hr) then begin DSPackException := EDSPackException.Create('Error Creating Allocator'); DSPackException.ErrorCode := hr; raise DSPackException; end; CheckDSError(VMRFilterConfig.SetRenderingMode(VMR9Mode_Renderless)); CheckDSError(FBaseFilter.QueryInterface(IID_IVMRSurfaceAllocatorNotify9, VMRSurfaceAllocatorNotify)); CheckDSError(FCurrentAllocator.QueryInterface(IID_IVMRSurfaceAllocator9, VMRSurfaceAllocator)); VMRSurfaceAllocatorNotify.AdviseSurfaceAllocator(FRenderLessUserID, VMRSurfaceAllocator); VMRSurfaceAllocator._AddRef; // manual increment; VMRSurfaceAllocator.AdviseNotify(VMRSurfaceAllocatorNotify); end; end; VMRFilterConfig := nil; finally Set8087CW(CW); end; end; vmNormal : CoCreateInstance(CLSID_VideoRenderer, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter ,FBaseFilter); end; end; foAdded: begin case mode of vmVMR: begin if (FBaseFilter <> nil) then if CheckDSError(FBaseFilter.QueryInterface(IVMRFilterConfig9, VMRFilterConfig)) = S_OK then begin if (FVMROptions.FStreams <> 4) or (vpForceMixer in FVMROptions.FPreferences) then begin CheckDSError(VMRFilterConfig.SetNumberOfStreams(FVMROptions.FStreams)); CheckDSError(VMRFilterConfig.GetNumberOfStreams(FVMROptions.FStreams)); end; case FVMROptions.Mode of vmrWindowed : begin CheckDSError(FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow)); UpdatePreferences; end; vmrWindowless : begin CheckDSError(FBaseFilter.QueryInterface(IVMRWindowlessControl9, FWindowLess)); CheckDSError(FWindowLess.SetVideoClippingWindow(Handle)); UpdatePreferences; Resize; end; vmrRenderless : begin //Assert(False, 'not yet imlemented.'); //CheckDSError(FBaseFilter.QueryInterface(IVMRWindowlessControl9, FWindowLess)); //CheckDSError(FWindowLess.SetVideoClippingWindow(Handle)); end; end; VMRFilterConfig := nil; VMROptions.SetKeepAspectRatio(VMROptions.FKeepAspectRatio); end; end; vmNormal: CheckDSError(FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow)); end; end; foRemoving: if FBaseFilter <> nil then begin // it's important to stop and disconnect the filter before removing the VMR filter. CheckDSError(FBaseFilter.Stop); EnumPins := TPinList.Create(FBaseFilter); if EnumPins.Count > 0 then for i := 0 to EnumPins.Count - 1 do CheckDSError(EnumPins.Items[i].Disconnect); EnumPins.Free; if (FCurrentAllocator <> nil) and (mode = vmVMR) and (VMROptions.Mode = vmrRenderless) then begin IUnKnown(FCurrentAllocator)._Release; FCurrentAllocator := nil; end; end; foRemoved : begin FVideoWindow := nil; FWindowLess := nil; FBaseFilter := nil; end; end; end; procedure TVideoWindow.Paint; begin inherited Paint; if Assigned(FOnPaint) then FOnPaint(self); end; procedure TVideoWindow.Resize; var ARect: TRect; begin inherited Resize; case FMode of vmNormal: begin if (FVideoWindow <> nil) and (not FullScreen) then FVideoWindow.SetWindowPosition(Left,Top,Width,Height); end; vmVMR: case FVMROptions.Mode of vmrWindowed: begin if (FVideoWindow <> nil) and (not FullScreen) then FVideoWindow.SetWindowPosition(Left,Top,Width,Height); end; vmrWindowless: if FWindowLess <> nil then begin ARect := Rect(0,0, width, height); FWindowLess.SetVideoPosition(nil, @ARect); end; end; end; end; procedure TVideoWindow.ConstrainedResize(var MinWidth, MinHeight, MaxWidth, MaxHeight: Integer); begin inherited ConstrainedResize(MinWidth, MinHeight, MaxWidth, MaxHeight); Resize; end; function TVideoWindow.GetVideoHandle: THandle; begin if FVideoWindow <> nil then result := FindWindowEx(Parent.Handle,0,Pchar('VideoRenderer'), Pchar(name)) else Result := Canvas.Handle; end; class function TVideoWindow.CheckVMR: boolean; var AFilter: IBaseFilter; CW: Word; begin CW := Get8087CW; try result := (CoCreateInstance(CLSID_VideoMixingRenderer9, nil, CLSCTX_INPROC, IID_IBaseFilter ,AFilter) = S_OK); finally Set8087CW(CW); AFilter := nil; end; end; procedure TVideoWindow.SetFullScreen(Value: boolean); var StyleEX: LongWord; begin if FVideoWindow <> nil then case Value of true: begin CheckDSError(FVideoWindow.put_Owner(0)); CheckDSError(FVideoWindow.put_WindowStyle(FWindowStyle and not(WS_BORDER or WS_CAPTION or WS_THICKFRAME))); StyleEX := FWindowStyleEx and not(WS_EX_CLIENTEDGE or WS_EX_STATICEDGE or WS_EX_WINDOWEDGE or WS_EX_DLGMODALFRAME); if FTopMost then StyleEX := StyleEX or WS_EX_TOPMOST; CheckDSError(FVideoWindow.put_WindowStyleEx(StyleEX)); CheckDSError(FVideoWindow.SetWindowPosition(0,0,screen.Width,screen.Height)); FIsFullScreen := true; end; false: begin CheckDSError(FVideoWindow.put_Owner(Parent.Handle)); CheckDSError(FVideoWindow.put_WindowStyle(FWindowStyle or WS_CHILD or WS_CLIPSIBLINGS)); CheckDSError(FVideoWindow.put_WindowStyleEx(FWindowStyleEx)); CheckDSError(FVideoWindow.SetWindowPosition(self.Left,self.Top,self.Width,self.Height)); FIsFullScreen := false; end; end; if FWindowLess <> nil then FIsFullScreen := false; FFullScreen := Value; end; function TVideoWindow.QueryInterface(const IID: TGUID; out Obj): HResult; begin if IsEqualGUID(IID_IVMRWindowlessControl9, IID) and (FWindowLess <> nil) then begin result := S_OK; IunKnown(Obj) := FWindowLess; exit; end; result := inherited QueryInterface(IID, Obj); if failed(result) and assigned(FBaseFilter) then result := FBaseFilter.QueryInterface(IID, Obj); end; procedure TVideoWindow.GraphEvent(Event, Param1, Param2: integer); begin case Event of EC_PALETTE_CHANGED: if FVideoWindow <> nil then begin SetFullScreen(FFullScreen); CheckDSError(FVideoWindow.put_Caption(name)); CheckDSError(FVideoWindow.put_MessageDrain(Handle)); end; EC_VMR_RENDERDEVICE_SET: begin if (FVMROptions.FMode = vmrWindowed) then begin CheckDSError(FVideoWindow.put_Caption(name)); CheckDSError(FVideoWindow.put_MessageDrain(Handle)); end; end; end; end; function TVideoWindow.CheckInputPinsConnected: boolean; var PinList: TPinList; i: Integer; begin result := False; if (FBaseFilter = nil) then Exit; PinList := TPinList.Create(FBaseFilter); try for i := 0 to PinList.Count - 1 do if PinList.Connected[i] then begin Result := True; Break; end; finally PinList.Free; end; end; procedure TVideoWindow.ControlEvent(Event: TControlEvent; Param: integer = 0); var FilterInfo: TFilterInfo; FilterList: TFilterList; i: integer; GUID: TGUID; begin case Event of ceDVDRendered: // mean our Video Filter have been removed begin ZeroMemory(@FilterInfo, SizeOf(TFilterInfo)); CheckDSError(FBaseFilter.QueryFilterInfo(FilterInfo)); if not assigned(FilterInfo.pGraph) then begin FilterList:= TFilterList.Create(FilterGraph.FFilterGraph); if FilterList.Count > 0 then for i := 0 to FilterList.Count - 1 do begin FilterList.Items[i].GetClassID(GUID); if ISEqualGUID(GUID, CLSID_VideoRenderer) and (Mode = vmNormal) then begin FBaseFilter := nil; FVideoWindow := nil; FWindowLess := nil; FBaseFilter := FilterList.Items[i]; FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow); break; end; end; end; end; cePlay: case FMode of vmNormal: if FVideoWindow <> nil then begin SetFullScreen(FFullScreen); CheckDSError(FVideoWindow.put_Caption(name)); CheckDSError(FVideoWindow.put_MessageDrain(Handle)); end; vmVMR: SetFullScreen(FFullScreen); end; end; end; procedure TVideoWindow.WndProc(var Message: TMessage); begin if ((Message.Msg = WM_CONTEXTMENU) and FullScreen) then begin if assigned(PopupMenu) then if PopupMenu.AutoPopup then begin PopupMenu.Popup(mouse.CursorPos.X, mouse.CursorPos.Y); Message.Result := 1; end; end else inherited WndProc(Message); end; procedure TVideoWindow.SetTopMost(TopMost: boolean); begin FTopMost := TopMost; if FFullScreen then SetFullScreen(true); end; procedure TVideoWindow.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if FIsFullScreen then inherited MouseDown(Button, Shift, mouse.CursorPos.X, mouse.CursorPos.Y) else inherited MouseDown(Button, Shift, X, Y) end; procedure TVideoWindow.MouseMove(Shift: TShiftState; X, Y: Integer); begin if Fisfullscreen then inherited MouseMove(Shift, mouse.CursorPos.X, mouse.CursorPos.Y) else inherited MouseMove(Shift, X, Y) end; procedure TVideoWindow.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Fisfullscreen then inherited MouseUp(Button, Shift, mouse.CursorPos.X, mouse.CursorPos.Y) else inherited MouseUp(Button, Shift, X, Y) end; function TVideoWindow.VMRGetBitMap(Stream: TStream): boolean; var Image: PBitmapInfoHeader; BFH: TBITMAPFILEHEADER; function DibSize: cardinal; begin result := (Image.biSize + Image.biSizeImage + Image.biClrUsed * sizeof(TRGBQUAD)); end; function DibNumColors: cardinal; begin if (image.biClrUsed = 0) and (image.biBitCount <= 8) then result := 1 shl integer(image.biBitCount) else result := image.biClrUsed; end; function DibPaletteSize: cardinal; begin result := (DibNumColors * sizeof(TRGBQUAD)) end; begin assert(assigned(Stream)); result := false; if FWindowLess <> nil then if Succeeded(FWindowLess.GetCurrentImage(PByte(image))) then begin BFH.bfType := $4d42; // BM BFH.bfSize := DibSize + sizeof(TBITMAPFILEHEADER); BFH.bfReserved1 := 0; BFH.bfReserved2 := 0; BFH.bfOffBits := sizeof(TBITMAPFILEHEADER) + image.biSize + DibPaletteSize; Stream.Write(BFH, SizeOf(TBITMAPFILEHEADER)); Stream.Write(image^, BFH.bfSize); Stream.Position :=0; CoTaskMemFree(image); result := true; end; end; function TVideoWindow.GetVisible: boolean; begin result := inherited visible; end; procedure TVideoWindow.SetVisible(Vis: boolean); begin inherited Visible := Vis; if assigned(FVideoWindow) then CheckDSError(FVideoWindow.put_Visible(vis)); end; procedure TVideoWindow.SetAllocator(Allocator: TAbstractAllocatorClass; UserID: Cardinal); begin FAllocatorClass := Allocator; FRenderLessUserID := UserID; end; // ***************************************************************************** // TSampleGrabber // ***************************************************************************** procedure TSampleGrabber.SetFilterGraph(AFilterGraph: TFilterGraph); begin if AFilterGraph = FFilterGraph then exit; if FFilterGraph <> nil then FFilterGraph.RemoveFilter(self); if AFilterGraph <> nil then AFilterGraph.InsertFilter(self); FFilterGraph := AFilterGraph; end; function TSampleGrabber.GetFilter: IBaseFilter; begin result := FBaseFilter; end; function TSampleGrabber.GetName: string; begin result := name; end; procedure TSampleGrabber.NotifyFilter(operation: TFilterOperation; Param: integer = 0); var EnumPins: IEnumPins; begin case operation of foAdding : Cocreateinstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC ,IID_IBASEFilter, FBaseFilter); foAdded : begin FBaseFilter.QueryInterface(IID_ISampleGrabber,SampleGrabber); FBaseFilter.EnumPins(EnumPins); EnumPins.Next(1,InPutPin,nil); EnumPins.Next(1,OutPutPin,nil); EnumPins := nil; UpdateMediaType; SampleGrabber.SetBufferSamples(true); if assigned(FOnBuffer) then SampleGrabber.SetCallback(Self ,1); end; foRemoving : begin FBaseFilter.Stop; InPutPin.Disconnect; OutPutPin.Disconnect; end; foRemoved : begin SampleGrabber.SetCallback(nil ,1); SampleGrabber.SetBufferSamples(false); FBaseFilter := nil; SampleGrabber := nil; InPutPin := nil; OutPutPin := nil; end; foRefresh: UpdateMediaType; end; end; constructor TSampleGrabber.Create(AOwner: TComponent); begin inherited Create(AOwner); FCriticalSection := TCriticalSection.Create; assert(CheckFilter, 'The SampleGrabber Filter is not available on this system.'); FMediaType := TMediaType.Create(MEDIATYPE_Video); FMediaType.SubType := MEDIASUBTYPE_RGB24; FMediaType.FormatType := FORMAT_VideoInfo; new(BMPInfo); end; destructor TSampleGrabber.Destroy; begin FilterGraph := nil; FMediaType.Free; Dispose(BMPInfo); FCriticalSection.Free; inherited destroy; end; class function TSampleGrabber.CheckFilter: boolean; var AFilter: IBaseFilter; begin result := Cocreateinstance(CLSID_SampleGrabber, nil, CLSCTX_INPROC ,IID_IBASEFilter, AFilter) = S_OK; AFilter := nil; end; procedure TSampleGrabber.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if ((AComponent = FFilterGraph) and (Operation = opRemove)) then FFilterGraph := nil; end; procedure TSampleGrabber.UpdateMediaType; begin if assigned(SampleGrabber) then begin FBaseFilter.Stop; InPutPin.Disconnect; SampleGrabber.SetMediaType(MediaType.AMMediaType^); end; end; procedure TSampleGrabber.SetBMPCompatible(Source: PAMMediaType; SetDefault: cardinal); var SubType : TGUID; BitCount: LongWord; begin BitCount := SetDefault; MediaType.ResetFormatBuffer; ZeroMemory(MediaType.AMMediaType, sizeof(TAMMediaType)); MediaType.majortype := MEDIATYPE_Video; MediaType.formattype := FORMAT_VideoInfo; if Source = nil then begin case SetDefault of 0 : MediaType.subtype := MEDIASUBTYPE_RGB24; 1 : MediaType.subtype := MEDIASUBTYPE_RGB1; 2 ..4 : MediaType.subtype := MEDIASUBTYPE_RGB4; 5 ..8 : MediaType.subtype := MEDIASUBTYPE_RGB8; 9 ..16 : MediaType.subtype := MEDIASUBTYPE_RGB555; 17..24 : MediaType.subtype := MEDIASUBTYPE_RGB24; 25..32 : MediaType.subtype := MEDIASUBTYPE_RGB32 else MediaType.subtype := MEDIASUBTYPE_RGB32; end; UpdateMediaType; exit; end; SubType := Source.subtype; if (IsEqualGUID(SubType, MEDIASUBTYPE_RGB1) or IsEqualGUID(SubType, MEDIASUBTYPE_RGB4) or IsEqualGUID(SubType, MEDIASUBTYPE_RGB8) or IsEqualGUID(SubType, MEDIASUBTYPE_RGB555) or IsEqualGUID(SubType, MEDIASUBTYPE_RGB24) or IsEqualGUID(SubType, MEDIASUBTYPE_RGB32)) then MediaType.subtype := SubType // no change else begin // get bitcount if assigned(Source.pbFormat) then if IsEqualGUID(Source.formattype, FORMAT_VideoInfo) then BitCount := PVideoInfoHeader(Source.pbFormat)^.bmiHeader.biBitCount else if IsEqualGUID(Source.formattype, FORMAT_VideoInfo2) then BitCount := PVideoInfoHeader2(Source.pbFormat)^.bmiHeader.biBitCount else if IsEqualGUID(Source.formattype, FORMAT_MPEGVideo) then BitCount := PMPEG1VideoInfo(Source.pbFormat)^.hdr.bmiHeader.biBitCount else if IsEqualGUID(Source.formattype, FORMAT_MPEG2Video) then BitCount := PMPEG2VideoInfo(Source.pbFormat)^.hdr.bmiHeader.biBitCount; case BitCount of 0 : MediaType.subtype := MEDIASUBTYPE_RGB24; 1 : MediaType.subtype := MEDIASUBTYPE_RGB1; 2 ..4 : MediaType.subtype := MEDIASUBTYPE_RGB4; 5 ..8 : MediaType.subtype := MEDIASUBTYPE_RGB8; 9 ..16 : MediaType.subtype := MEDIASUBTYPE_RGB555; 17..24 : MediaType.subtype := MEDIASUBTYPE_RGB24; 25..32 : MediaType.subtype := MEDIASUBTYPE_RGB32 else MediaType.subtype := MEDIASUBTYPE_RGB32; end; end; UpdateMediaType; end; function TSampleGrabber.GetBitmap(Bitmap: TBitmap; Buffer: Pointer; BufferLen: Integer): boolean; var hr : HRESULT; BMIHeader : TBitmapInfoHeader; AMediaType : TAMMediaType; buf : pointer; begin result := false; if ((Buffer = nil) or (BufferLen = 0)) then exit; if not assigned(Bitmap) then exit; hr := SampleGrabber.GetConnectedMediaType(AMediaType); if (hr <> S_OK) then exit; if IsEqualGUID(AMediaType.majortype, MEDIATYPE_Video) then begin case Amediatype.formattype.D1 of $05589F80: BMIHeader := PVideoInfoHeader(Amediatype.pbFormat)^.bmiHeader; $F72A76A0: BMIHeader := PVideoInfoHeader2(Amediatype.pbFormat)^.bmiHeader; end; FillChar(BMPInfo^, 44, 0); Move(bmiHeader, BMPInfo.bmiHeader, 40); bitmap.Handle := CreateDIBSection(0, BMPInfo^, DIB_RGB_COLORS, buf, 0, 0); if buf = nil then exit; Move(buffer^, buf^, BufferLen); result := true; end; FreeMediaType(@AMediaType); end; function TSampleGrabber.GetBitmap(Bitmap: TBitmap): boolean; var hr : HRESULT; BMIHeader : TBitmapInfoHeader; BufferSize : longint; AMediaType : TAMMediaType; buffer : pointer; begin result := false; if not assigned(Bitmap) then exit; if not assigned(SampleGrabber) then exit; hr := SampleGrabber.GetConnectedMediaType(AMediaType); if (hr <> S_OK) then exit; if IsEqualGUID(AMediaType.majortype, MEDIATYPE_Video) then begin case Amediatype.formattype.D1 of $05589F80: BMIHeader := PVideoInfoHeader(Amediatype.pbFormat)^.bmiHeader; $F72A76A0: BMIHeader := PVideoInfoHeader2(Amediatype.pbFormat)^.bmiHeader; end; ZeroMemory(BMPInfo, sizeof(TBitmapInfo)); CopyMemory(@BMPInfo.bmiHeader, @bmiHeader, sizeof(TBITMAPINFOHEADER)); bitmap.Handle := CreateDIBSection(0, BMPInfo^, DIB_RGB_COLORS, buffer, 0, 0); HR := SampleGrabber.GetCurrentBuffer(BufferSize, buffer); if (hr <> S_OK) then exit; result := true; end; FreeMediaType(@AMediaType); end; function TSampleGrabber.QueryInterface(const IID: TGUID; out Obj): HResult; begin result := inherited QueryInterface(IID, Obj); if failed(result) and assigned(FBaseFilter) then result := FBaseFilter.QueryInterface(IID, Obj); end; function TSampleGrabber.BufferCB(SampleTime: Double; pBuffer: PByte; BufferLen: Integer): HResult; begin if assigned(FOnBuffer) then begin FCriticalSection.Enter; try FOnBuffer(self, SampleTime, pBuffer, BufferLen); finally FCriticalSection.Leave; end; end; result := S_OK; end; function TSampleGrabber.SampleCB(SampleTime: Double; pSample: IMediaSample): HResult; begin result := S_OK; end; // ***************************************************************************** // TFilter // ***************************************************************************** function TFilter.GetFilter: IBaseFilter; begin result := FFilter; end; function TFilter.GetName: string; begin result := name; end; procedure TFilter.NotifyFilter(operation: TFilterOperation; Param: integer = 0); begin case operation of foAdding: FFilter := BaseFilter.CreateFilter; foRemoving: if FFilter <> nil then FFilter.Stop; foRemoved: FFilter := nil; foRefresh: if assigned(FFilterGraph) then begin FFilterGraph.RemoveFilter(self); FFilterGraph.InsertFilter(self); end; end; end; constructor TFilter.Create(AOwner: TComponent); begin inherited Create(AOwner); FBaseFilter := TBaseFilter.Create; end; destructor TFilter.Destroy; begin FBaseFilter.Free; FilterGraph := nil; inherited Destroy; end; procedure TFilter.SetFilterGraph(AFilterGraph: TFilterGraph); begin if AFilterGraph = FFilterGraph then exit; if FFilterGraph <> nil then FFilterGraph.RemoveFilter(self); if AFilterGraph <> nil then AFilterGraph.InsertFilter(self); FFilterGraph := AFilterGraph; end; procedure TFilter.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if ((AComponent = FFilterGraph) and (Operation = opRemove)) then FFilterGraph := nil; end; function TFilter.QueryInterface(const IID: TGUID; out Obj): HResult; begin result := inherited QueryInterface(IID, Obj); if not Succeeded(Result) then if Assigned(FFilter) then result := FFilter.QueryInterface(IID, Obj); end; // ***************************************************************************** // TASFWriter // ***************************************************************************** constructor TASFWriter.Create(AOwner: TComponent); begin inherited Create(AOwner); FAutoIndex := true; FMultiPass := False; FDontCompress := False; end; destructor TASFWriter.Destroy; begin FilterGraph := nil; inherited Destroy; end; procedure TASFWriter.SetFilterGraph(AFilterGraph: TFilterGraph); begin if AFilterGraph = FFilterGraph then exit; if FFilterGraph <> nil then FFilterGraph.RemoveFilter(self); if AFilterGraph <> nil then AFilterGraph.InsertFilter(self); FFilterGraph := AFilterGraph; end; function TASFWriter.GetFilter: IBaseFilter; begin result := FFilter; end; function TASFWriter.GetName: string; begin result := name; end; procedure TASFWriter.NotifyFilter(operation: TFilterOperation; Param: integer = 0); var PinList: TPinList; ServiceProvider: IServiceProvider; FAsfConfig: IConfigAsfWriter2; begin case operation of foAdding: cocreateinstance(CLSID_WMAsfWriter, nil, CLSCTX_INPROC ,IBaseFilter, FFilter); foAdded : begin if assigned(FFilter) then begin SetProfile(FProfile); SetFileName(FFileName); if Succeeded(FFilter.QueryInterface(IID_IConfigAsfWriter2, FAsfConfig)) then begin FAsfConfig.SetParam(AM_CONFIGASFWRITER_PARAM_AUTOINDEX, Cardinal(FAutoIndex), 0); FAsfConfig.SetParam(AM_CONFIGASFWRITER_PARAM_MULTIPASS, Cardinal(FMultiPass), 0); FAsfConfig.SetParam(AM_CONFIGASFWRITER_PARAM_DONTCOMPRESS, Cardinal(FDontCompress), 0); end; PinList:= TPinList.Create(FFilter); try if PinList.Count >= 1 then begin AudioInput := PinList.Items[0]; if PinList.Count = 2 then begin VideoInput := PinList.Items[1]; VideoInput.QueryInterface(IID_IAMStreamConfig, VideoStreamConfig); end; AudioInput.QueryInterface(IID_IAMStreamConfig, AudioStreamConfig); if Succeeded(QueryInterface(IServiceProvider, ServiceProvider)) then begin ServiceProvider.QueryService(IID_IWMWriterAdvanced2, IID_IWMWriterAdvanced2, WriterAdvanced2); ServiceProvider := nil; end; if ((FPort > 0) and (FMaxUsers > 0)) then if Succeeded(WMCreateWriterNetworkSink(WriterNetworkSink)) then begin WriterNetworkSink.SetNetworkProtocol(WMT_PROTOCOL_HTTP); WriterNetworkSink.SetMaximumClients(FMaxUsers); WriterNetworkSink.Open(FPort); WriterAdvanced2.AddSink(WriterNetworkSink); end; end; finally PinList.Free; end; end; end; foRemoving: begin if assigned(FFilter) then FFilter.Stop; if assigned(WriterNetworkSink) then begin WriterNetworkSink.Disconnect; WriterNetworkSink.Close; end; if assigned(AudioInput) then AudioInput.Disconnect; if assigned(VideoInput) then VideoInput.Disconnect; end; foRemoved: begin WriterAdvanced2 := nil; WriterNetworkSink := nil; AudioInput := nil; VideoInput := nil; AudioStreamConfig := nil; VideoStreamConfig := nil; FFilter := nil; end; end; end; procedure TASFWriter.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if ((AComponent = FFilterGraph) and (Operation = opRemove)) then FFilterGraph := nil; end; function TASFWriter.GetProfile: TWMPofiles8; var GUIDProf: TGUID; ConfigAsfWriter: IConfigAsfWriter; begin if Succeeded(QueryInterface(IConfigAsfWriter, ConfigAsfWriter)) then begin ConfigAsfWriter.GetCurrentProfileGuid(GUIDProf); result := ProfileFromGUID(GUIDProf); ConfigAsfWriter := nil; end else result := FProfile end; procedure TASFWriter.SetProfile(profile: TWMPofiles8); var ConfigAsfWriter: IConfigAsfWriter; begin if Succeeded(QueryInterface(IConfigAsfWriter, ConfigAsfWriter)) then begin ConfigAsfWriter.ConfigureFilterUsingProfileGuid(WMProfiles8[profile]); ConfigAsfWriter := nil; end else FProfile := profile; end; function TASFWriter.GetFileName: String; var F: PWideChar; FileSinkFilter2: IFileSinkFilter2; begin if Succeeded(QueryInterface(IFileSinkFilter2, FileSinkFilter2)) then begin FileSinkFilter2.GetCurFile(F,nil); FileSinkFilter2 := nil; result := F; end else result := FFileName; end; procedure TASFWriter.SetFileName(FileName: String); var FileSinkFilter2: IFileSinkFilter2; begin FFileName := FileName; if Succeeded(QueryInterface(IFileSinkFilter2, FileSinkFilter2)) then begin FileSinkFilter2.SetFileName(PWideChar(FFileName),nil); FileSinkFilter2 := nil; end; end; function TASFWriter.QueryInterface(const IID: TGUID; out Obj): HResult; begin result := inherited QueryInterface(IID, Obj); if failed(result) and assigned(FFilter) then result := FFilter.QueryInterface(IID, Obj); end; // ***************************************************************************** // TDSTrackBar // ***************************************************************************** procedure TDSTrackBar.SetFilterGraph(AFilterGraph: TFilterGraph); begin if AFilterGraph = FFilterGraph then exit; if FFilterGraph <> nil then FFilterGraph.RemoveEventNotifier(self); if AFilterGraph <> nil then AFilterGraph.InsertEventNotifier(self); FFilterGraph := AFilterGraph; end; constructor TDSTrackBar.Create(AOwner: TComponent); begin inherited Create(AOwner); FMouseDown := false; FEnabled := false; FInterval := 1000; FWindowHandle := AllocateHWnd(TimerWndProc); end; destructor TDSTrackBar.Destroy; begin FEnabled := False; UpdateTimer; FilterGraph := nil; DeallocateHWnd(FWindowHandle); FMediaSeeking := nil; inherited Destroy; end; procedure TDSTrackBar.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if ((AComponent = FFilterGraph) and (Operation = opRemove)) then begin FMediaSeeking := nil; FFilterGraph := nil; end; end; procedure TDSTrackBar.GraphEvent(Event, Param1, Param2: integer); var Duration: int64; Zero: int64; begin case Event of EC_CLOCK_CHANGED: if assigned(FMediaSeeking) then begin Zero := 0; FMediaSeeking.GetDuration(Duration); FMediaSeeking.SetPositions(Zero, AM_SEEKING_AbsolutePositioning, Duration , AM_SEEKING_NoPositioning); end; end; end; procedure TDSTrackBar.ControlEvent(Event: TControlEvent; Param: integer = 0); begin case event of cePlay: TimerEnabled := Enabled; cePause..ceStop: TimerEnabled := false; ceActive: case Param of 0: FMediaSeeking := nil; 1: FFilterGraph.QueryInterface(IMediaSeeking, FMediaSeeking); end; end; end; procedure TDSTrackBar.SetTimerEnabled(Value: Boolean); begin if Value <> FEnabled then begin FEnabled := Value; UpdateTimer; end; end; procedure TDSTrackBar.SetInterval(Value: Cardinal); begin if Value <> FInterval then begin FInterval := Value; UpdateTimer; end; end; procedure TDSTrackBar.SetOnTimer(Value: TTimerEvent); begin FOnTimer := Value; UpdateTimer; end; procedure TDSTrackBar.UpdateTimer; begin KillTimer(FWindowHandle, 1); if (FInterval <> 0) and FEnabled then if SetTimer(FWindowHandle, 1, FInterval, nil) = 0 then raise EOutOfResources.Create(SNoTimers); end; procedure TDSTrackBar.Timer; var CurrentPos, StopPos: int64; MlsCurrentPos, MlsStopPos: Cardinal; begin if assigned(FMediaSeeking) and (not FMouseDown) then if Succeeded(FMediaSeeking.GetDuration(StopPos)) then if Succeeded(FMediaSeeking.GetCurrentPosition(CurrentPos)) then begin MlsCurrentPos := RefTimeToMiliSec(CurrentPos); MlsStopPos := RefTimeToMiliSec(StopPos); min := 0; max := MlsStopPos div TimerInterval; Position := MlsCurrentPos div TimerInterval; if Assigned(FOnTimer) then FOnTimer(Self, MlsCurrentPos, MlsStopPos); end; end; procedure TDSTrackBar.TimerWndProc(var Msg: TMessage); begin with Msg do if Msg = WM_TIMER then try Timer; except Application.HandleException(Self); end else Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam); end; procedure TDSTrackBar.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var StopPosition, CurrentPosition: int64; begin inherited MouseUp(Button, Shift, X, Y); if Button = mbLeft then if assigned(FMediaSeeking) then begin FMediaSeeking.GetStopPosition(StopPosition); CurrentPosition := (StopPosition * Position) div max ; FMediaSeeking.SetPositions(CurrentPosition, AM_SEEKING_AbsolutePositioning, StopPosition , AM_SEEKING_NoPositioning); end; FMouseDown := False; end; procedure TDSTrackBar.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited MouseDown(Button, Shift, X, Y); if Button = mbLeft then FMouseDown := true; end; // --------------------------- Color Control ------------------------------- constructor TColorControl.Create(AOwner: TDSVideoWindowEx2); begin inherited Create; FOwner := AOwner; ZeroMemory(@FDefault,SizeOf(TDDColorControl)); with FDefault do begin dwSize := SizeOf(TDDCOLORCONTROL); dwFlags := DDCOLOR_BRIGHTNESS or DDCOLOR_CONTRAST or DDCOLOR_HUE or DDCOLOR_SATURATION or DDCOLOR_GAMMA or DDCOLOR_SHARPNESS or DDCOLOR_COLORENABLE; lBrightness := 750; lContrast := 10000; lGamma := 1; lHue := 0; lSaturation := 10000; lSharpness := 5; lColorEnable := integer(True); dwReserved1 := 0; end; FBrightness := FDefault.lBrightness; FContrast := FDefault.lContrast; FGamma := FDefault.lGamma; FHue := FDefault.lHue; FSaturation := FDefault.lSaturation; FSharpness := FDefault.lSharpness; FUtilColor := Bool(FDefault.lColorEnable); end; procedure TColorControl.ReadDefault; var EnumPins : IEnumPins; Pin : IPin; ul : cardinal; pd : TPinDirection; MPC : IMixerPinConfig2; Tel : Integer; FG : IFilterGraph; FilterList : TFilterList; Hr : HResult; OVM : IBaseFilter; FClass : TGuid; Tmp : TDDColorControl; begin if (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState) or (TDSVideoWindowEx2(FOwner).FFilterGraph = nil) or (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = False) then Exit; MPC := nil; OVM := nil; FG := nil; FG := TDSVideoWindowEx2(FOwner).FFilterGraph.FFilterGraph; FilterList := TFilterList.Create(FG); try for Tel := 0 to FilterList.Count -1 do begin FilterList[Tel].GetClassID(FClass); if IsEqualGuid(FClass, CLSID_OverlayMixer) then OVM := FilterList[Tel]; if IsEqualGuid(FClass, CLSID_OverlayMixer2) then OVM := FilterList[Tel]; end; if OVM = nil then Exit; Hr := OVM.EnumPins(EnumPins); if Failed(Hr) then Exit; Tel := 0; while (EnumPins.Next(1, Pin, @ul) = S_OK) and (ul = 1) and (Tel = 0) do begin Hr := Pin.QueryDirection(pd); if Failed(Hr) then Exit; if pd = PINDIR_INPUT then begin Hr := Pin.QueryInterface(IID_IMixerPinConfig2, MPC); if Failed(Hr) then Exit; Inc(Tel); end; Pin := nil; end; EnumPins := nil; ZeroMemory(@Tmp,SizeOf(TDDColorControl)); Tmp.dwSize:=SizeOf(TDDCOLORCONTROL); Hr := MPC.GetOverlaySurfaceColorControls(Tmp); if Failed(Hr) then Exit; FDefault := Tmp; finally FilterList.Free; FG := nil; OVM := nil; EnumPins := nil; Pin := nil; MPC := nil; end; end; procedure TColorControl.UpdateColorControls; var EnumPins : IEnumPins; Pin : IPin; ul : cardinal; pd : TPinDirection; MPC : IMixerPinConfig2; Tel : Integer; FG : IFilterGraph; FilterList : TFilterList; Hr : HResult; OVM : IBaseFilter; FClass : TGuid; Tmp : TDDColorControl; begin if (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState) or (TDSVideoWindowEx2(FOwner).FFilterGraph = nil) or (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = False) then Exit; MPC := nil; OVM := nil; FG := nil; FG := TDSVideoWindowEx2(FOwner).FFilterGraph.FFilterGraph; FilterList := TFilterList.Create(FG); try for Tel := 0 to FilterList.Count -1 do begin FilterList[Tel].GetClassID(FClass); if IsEqualGuid(FClass, CLSID_OverlayMixer) then OVM := FilterList[Tel]; if IsEqualGuid(FClass, CLSID_OverlayMixer2) then OVM := FilterList[Tel]; end; if OVM = nil then Exit; Hr := OVM.EnumPins(EnumPins); if Failed(Hr) then Exit; Tel := 0; while (EnumPins.Next(1, Pin, @ul) = S_OK) and (ul = 1) and (Tel = 0) do begin Hr := Pin.QueryDirection(pd); if Failed(Hr) then Exit; if pd = PINDIR_INPUT then begin Hr := Pin.QueryInterface(IID_IMixerPinConfig2, MPC); if Failed(Hr) then Exit; Inc(Tel); end; Pin := nil; end; EnumPins := nil; Tmp.dwSize := SizeOf(TDDCOLORCONTROL); Tmp.dwFlags := DDCOLOR_BRIGHTNESS or DDCOLOR_CONTRAST or DDCOLOR_HUE or DDCOLOR_SATURATION or DDCOLOR_GAMMA or DDCOLOR_SHARPNESS or DDCOLOR_COLORENABLE; Tmp.lBrightness := FBrightness; Tmp.lContrast := FContrast; Tmp.lHue := FHue; Tmp.lSaturation := FSaturation; Tmp.lSharpness := FSharpness; Tmp.lGamma := FGamma; Tmp.lColorEnable := integer(FUtilColor); Tmp.dwReserved1 := 0; Hr := MPC.setOverlaySurfaceColorControls(Pointer(@Tmp)); if Failed(Hr) then Exit; finally FilterList.Free; FG := nil; OVM := nil; EnumPins := nil; Pin := nil; MPC := nil; end; end; procedure TColorControl.GetColorControls; var EnumPins : IEnumPins; Pin : IPin; ul : cardinal; pd : TPinDirection; MPC : IMixerPinConfig2; Tel : Integer; FG : IFilterGraph; FilterList : TFilterList; Hr : HResult; OVM : IBaseFilter; FClass : TGuid; Tmp : TDDColorControl; begin if (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState) or (TDSVideoWindowEx2(FOwner).FFilterGraph = nil) or (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = False) then Exit; MPC := nil; OVM := nil; FG := nil; FG := TDSVideoWindowEx2(FOwner).FFilterGraph.FFilterGraph; FilterList := TFilterList.Create(FG); try for Tel := 0 to FilterList.Count -1 do begin FilterList[Tel].GetClassID(FClass); if IsEqualGuid(FClass, CLSID_OverlayMixer) then OVM := FilterList[Tel]; if IsEqualGuid(FClass, CLSID_OverlayMixer2) then OVM := FilterList[Tel]; end; if OVM = nil then Exit; Hr := OVM.EnumPins(EnumPins); if Failed(Hr) then Exit; Tel := 0; while (EnumPins.Next(1, Pin, @ul) = S_OK) and (ul = 1) and (Tel = 0) do begin Hr := Pin.QueryDirection(pd); if Failed(Hr) then Exit; if pd = PINDIR_INPUT then begin Hr := Pin.QueryInterface(IID_IMixerPinConfig2, MPC); if Failed(Hr) then Exit; Inc(Tel); end; Pin := nil; end; EnumPins := nil; ZeroMemory(@Tmp,SizeOf(TDDColorControl)); Tmp.dwSize := SizeOf(TDDCOLORCONTROL); Hr := MPC.GetOverlaySurfaceColorControls(Tmp); if Failed(Hr) then begin FBrightness := 750; FContrast := 10000; FHue := 0; FSaturation := 10000; FSharpness := 5; FGamma := 1; FUtilColor := True; Exit; end else begin FBrightness := Tmp.lBrightness; FContrast := Tmp.lContrast; FHue := Tmp.lHue; FSaturation := Tmp.lSaturation; FSharpness := Tmp.lSharpness; FGamma := Tmp.lGamma; FUtilColor := Bool(Tmp.lColorEnable); end; finally FilterList.Free; FG := nil; OVM := nil; EnumPins := nil; Pin := nil; MPC := nil; end; end; procedure TColorControl.RestoreDefault; begin FBrightness := FDefault.lBrightness; FContrast := FDefault.lContrast; FHue := FDefault.lHue; FSaturation := FDefault.lSaturation; FSharpness := FDefault.lSharpness; FGamma := FDefault.lGamma; FUtilColor := Bool(FDefault.lColorEnable); if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end; Procedure TColorControl.SetBrightness(Value : Integer); begin if (Value > -1) and (Value < 10001) then begin if Value <> FBrightness then FBrightness := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end else raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 10.000', [Value]); end; Procedure TColorControl.SetContrast(Value : Integer); begin if (Value > -1) and (Value < 20001) then begin if Value <> FContrast then FContrast := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end else raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 20.000', [Value]); end; procedure TColorControl.SetHue(Value : Integer); begin if (Value > -181) and (Value < 182) then begin if Value <> FHue then FHue := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end else raise Exception.CreateFmt('Value %d out of range. Value must bee between -180 -> 180', [Value]); end; procedure TColorControl.SetSaturation(Value : Integer); begin if (Value > -1) and (Value < 20001) then begin if Value <> FSaturation then FSaturation := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end else raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 20.000', [Value]); end; procedure TColorControl.SetSharpness(Value : Integer); begin if (Value > -1) and (Value < 11) then begin if Value <> FSharpness then FSharpness := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end else raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 10', [Value]); end; procedure TColorControl.SetGamma(Value : Integer); begin if (Value > 0) and (Value < 501) then begin if Value <> FGamma then FGamma := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end else raise Exception.CreateFmt('Value %d out of range. Value must bee between 1 -> 500', [Value]); end; procedure TColorControl.SetUtilColor(Value : Boolean); begin FUtilColor := Value; if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then UpdateColorControls; end; function TColorControl.GetBrightness : Integer; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fBrightness; end; function TColorControl.GetContrast : Integer; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fContrast; end; function TColorControl.GetHue : Integer; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fHue; end; function TColorControl.GetSaturation : Integer; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fSaturation; end; function TColorControl.GetSharpness : Integer; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fSharpness; end; function TColorControl.GetGamma : Integer; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fGamma; end; function TColorControl.GetUtilColor : Boolean; begin if (not (csDesigning in TDSVideoWindowEx2(FOwner).ComponentState)) and (TDSVideoWindowEx2(FOwner).FFilterGraph <> nil) and (TDSVideoWindowEx2(FOwner).FFilterGraph.Active = True) then GetColorControls; Result := fUtilColor; end; // ---------------------- DSVideoWindowEx2Capabilities ------------------- constructor TDSVideoWindowEx2Caps.create(AOwner: TDSVideoWindowEx2); begin inherited Create; Owner := AOwner; end; function TDSVideoWindowEx2Caps.GetCanOverlay : Boolean; begin Result := TDSVideoWindowEx2(Owner).FOverlayMixer <> nil; end; function TDSVideoWindowEx2Caps.GetCanControlBrigtness : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_BRIGHTNESS = DDCOLOR_BRIGHTNESS else Result := False; end; function TDSVideoWindowEx2Caps.GetCanControlContrast : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_CONTRAST = DDCOLOR_CONTRAST else Result := False; end; function TDSVideoWindowEx2Caps.GetCanControlHue : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_HUE = DDCOLOR_HUE else Result := False; end; function TDSVideoWindowEx2Caps.GetCanControlSaturation : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_SATURATION = DDCOLOR_SATURATION else Result := False; end; function TDSVideoWindowEx2Caps.GetCanControlSharpness : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_SHARPNESS = DDCOLOR_SHARPNESS else Result := False; end; function TDSVideoWindowEx2Caps.GetCanControlGamma : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_GAMMA = DDCOLOR_GAMMA else Result := False; end; function TDSVideoWindowEx2Caps.GetCanControlUtilizedColor : Boolean; begin if TDSVideoWindowEx2(Owner).FColorControl <> nil then Result := TDSVideoWindowEx2(Owner).FColorControl.FDefault.dwFlags and DDCOLOR_COLORENABLE = DDCOLOR_COLORENABLE else Result := False; end; // ----------------------------------- Overlay Callback ------------------ constructor TOverlayCallBack.Create(Owner : TObject); begin AOwner := Owner; end; function TOverlayCallback.OnUpdateOverlay(bBefore: BOOL; dwFlags: DWORD; bOldVisible: BOOL; var prcOldSrc, prcOldDest: TRECT; bNewVisible: BOOL; var prcNewSrc, prcNewDest: TRECT): HRESULT; stdcall; begin Result := S_OK; end; function TOverlayCallback.OnUpdateColorKey(var pKey: TCOLORKEY; dwColor: DWORD): HRESULT; stdcall; begin TDSVideoWindowEx2(AOwner).FColorKey := pKey.HighColorValue; if Assigned(TDSVideoWindowEx2(AOwner).FOnColorKey) then TDSVideoWindowEx2(AOwner).FOnColorKey(Self); Result := S_OK; end; function TOverlayCallback.OnUpdateSize(dwWidth, dwHeight, dwARWidth, dwARHeight: DWORD): HRESULT; stdcall; begin if (AOwner = nil) then begin Result := S_OK; Exit; end; TDSVideoWindowEx2(AOwner).GetVideoInfo; TDSVideoWindowEx2(AOwner).Clearback; Result := S_OK; end; // ------------------------------ DSVideoWindowEx ------------------------- procedure TDSVideoWindowEx2.NotifyFilter(operation: TFilterOperation; Param: integer); var i: integer; EnumPins: TPinList; pGB : IGraphBuilder; begin EnumPins := nil; pGB := nil; try case operation of foAdding: begin GraphWasUpdatet := False; CoCreateInstance(CLSID_VideoRenderer, nil, CLSCTX_INPROC_SERVER, IID_IBaseFilter ,FBaseFilter); end; foAdded: begin FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow); end; foRemoving: begin if FOverlayMixer <> nil then begin FColorControl.RestoreDefault; FBaseFilter.Stop; EnumPins := TPinList.Create(FOverlayMixer); if EnumPins.Count > 0 then for i := 0 to EnumPins.Count - 1 do EnumPins.Items[i].Disconnect; end; if FBaseFilter <> nil then begin FBaseFilter.Stop; EnumPins := TPinList.Create(FBaseFilter); if EnumPins.Count > 0 then for i := 0 to EnumPins.Count - 1 do EnumPins.Items[i].Disconnect; end; if FDDXM <> nil then FDDXM.SetCallbackInterface(nil, 0); if OverlayCallback <> nil then OverlayCallback := nil; end; foRemoved : begin GraphWasUpdatet := False; FDDXM := nil; FOverlayMixer := nil; FVideoRenderer := nil; FVideoWindow := nil; FBaseFilter := nil; end; end; finally if EnumPins <> nil then EnumPins.Free; pGB := nil; end; end; procedure TDSVideoWindowEx2.GraphEvent(Event, Param1, Param2: integer); begin case Event of EC_PALETTE_CHANGED : RefreshVideoWindow; EC_CLOCK_CHANGED : begin if GraphBuildOk then SetVideoZOrder; SetZoom(FZoom); SetAspectMode(FAspectMode); if GraphBuildOk then ClearBack; end; end; end; function TDSVideoWindowEx2.GetName: string; begin result := name; end; procedure TDSVideoWindowEx2.ControlEvent(Event: TControlEvent; Param: integer = 0); var FilterInfo: TFilterInfo; FilterList: TFilterList; i: integer; GUID: TGUID; TmpName : WideString; begin FilterList := nil; try case Event of ceDVDRendered: begin // mean our Video Filter have been removed ZeroMemory(@FilterInfo, SizeOf(TFilterInfo)); FBaseFilter.QueryFilterInfo(FilterInfo); if not assigned(FilterInfo.pGraph) then begin FilterList:= TFilterList.Create(FilterGraph.FFilterGraph); if FilterList.Count > 0 then for i := 0 to FilterList.Count - 1 do begin FilterList.Items[i].GetClassID(GUID); if ISEqualGUID(GUID, CLSID_VideoRenderer) then begin FOverlayMixer := nil; FBaseFilter := nil; FVideoWindow := nil; FVideoRenderer := nil; FBaseFilter := FilterList.Items[i]; FBaseFilter.QueryInterface(IVideoWindow, FVideoWindow); GraphBuildOk := Succeeded(UpdateGraph); if GraphBuildOk then begin FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls. end; RefreshVideoWindow; break; end else if ISEqualGUID(GUID, CLSID_VideoMixingRenderer) then begin FOverlayMixer := nil; FBaseFilter := nil; FVideoRenderer := nil; TmpName := Name; if FVideoWindow <> nil then FilterGraph.FFilterGraph.AddFilter(FVideoWindow as IBaseFilter, PWideChar(TmpName)); FBaseFilter := FVideoWindow as IBaseFilter; GraphBuildOk := Succeeded(UpdateGraph); if GraphBuildOk then begin FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls. end; RefreshVideoWindow; break; end; end; end; end; cePlay: begin if not GraphWasUpdatet then begin GraphBuildOk := Succeeded(UpdateGraph); if GraphBuildOk then begin FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls. end; RefreshVideoWindow; end; if GraphBuildOk then begin if (not FOverlayVisible) and (not FDesktopPlay) then begin FOverlayVisible := True; if Assigned(FOnOverlay) then FOnOverlay(Self, True); Clearback; end; end; end; cePause: begin if not GraphWasUpdatet then begin GraphBuildOk := Succeeded(UpdateGraph); if GraphBuildOk then begin FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls. end; RefreshVideoWindow; end; if GraphBuildOk then if (not FOverlayVisible) and (not FDesktopPlay) then begin FOverlayVisible := True; if Assigned(FOnOverlay) then FOnOverlay(Self, True); Clearback; end; end; ceStop: begin if not GraphWasUpdatet then begin GraphBuildOk := Succeeded(UpdateGraph); if GraphBuildOk then begin FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls. end; RefreshVideoWindow; end; if GraphBuildOk then if FOverlayVisible then begin FOverlayVisible := False; Clearback; if Assigned(FOnOverlay) then FOnOverlay(Self, False); end; end; ceFileRendered: begin GraphBuildOk := Succeeded(UpdateGraph); if GraphBuildOk then begin FColorControl.ReadDefault; // Read the Colorcontrols settings of the OverlayMixer. FColorControl.UpdateColorControls; // Apply our settings to the ColorControls. end; RefreshVideoWindow; end; end; finally if FilterList <> nil then FilterList.Free; end; end; procedure TDSVideoWindowEx2.RefreshVideoWindow; begin if FVideoWindow <> nil then with FVideoWindow do begin put_Owner(Parent.Handle); put_WindowStyle(FWindowStyle or WS_CHILD or WS_CLIPSIBLINGS); put_WindowStyleEx(FWindowStyleEx); SetWindowPosition(Left, Top, Width, Height); put_Caption(name); put_MessageDrain(Handle); Application.ProcessMessages; put_AutoShow(not FDesktopPlay); end; end; function TDSVideoWindowEx2.GetFilter: IBaseFilter; begin result := FBaseFilter; end; constructor TDSVideoWindowEx2.Create(AOwner: TComponent); begin inherited Create(AOwner); ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, csDoubleClicks, csReflector]; TabStop := true; Height := 240; Width := 320; color := $000000; FColorKey := clNone; FFullScreen := false; FColorControl := TColorControl.create(Self); FCaps := TDSVideoWindowEx2Caps.Create(Self); AspectRatio := rmLetterBox; DigitalZoom := 0; GraphBuildOK := False; FNoScreenSaver := False; FIdleCursor := 0; if (csDesigning in componentstate) then Exit; FFullScreenControl := TForm.Create(nil); FFullScreenControl.Color := Color; FFullScreenControl.DefaultMonitor := dmDesktop; FFullScreenControl.BorderStyle := bsNone; FFullScreenControl.OnCloseQuery := FullScreenCloseQuery; FOldParent := nil; FMonitor := nil; FVideoWindowHandle := 0; GraphWasUpdatet := False; Application.OnIdle := MyIdleHandler; end; destructor TDSVideoWindowEx2.Destroy; begin if DesktopPlayback then NormalPlayback; if FDDXM <> nil then FDDXM.SetCallbackInterface(nil, 0); OverlayCallback := nil; FOverlayMixer := nil; FFilterGraph := nil; FVideoWindow := nil; FVideoRenderer := nil; FCaps.Free; FColorControl.Free; inherited Destroy; end; procedure TDSVideoWindowEx2.resize; begin if (FVideoWindow <> nil) and (not FFullScreen) and (not DesktopPlayback) then FVideoWindow.SetWindowPosition(Left,Top,Width,Height); end; procedure TDSVideoWindowEx2.Loaded; begin inherited Loaded; FWindowStyle := GetWindowLong(Handle, GWL_STYLE); FWindowStyleEx := GetWindowLong(Handle, GWL_EXSTYLE); end; procedure TDSVideoWindowEx2.Notification(AComponent: TComponent; Operation: TOperation); begin inherited Notification(AComponent, Operation); if ((AComponent = FFilterGraph) and (Operation = opRemove)) then FFilterGraph := nil; end; procedure TDSVideoWindowEx2.SetFilterGraph(AFilterGraph: TFilterGraph); begin if AFilterGraph = FFilterGraph then exit; if FFilterGraph <> nil then begin FFilterGraph.RemoveFilter(self); FFilterGraph.RemoveEventNotifier(self); end; if AFilterGraph <> nil then begin AFilterGraph.InsertFilter(self); AFilterGraph.InsertEventNotifier(self); end; FFilterGraph := AFilterGraph; end; procedure TDSVideoWindowEx2.SetTopMost(TopMost: boolean); begin FTopMost := TopMost; end; procedure TDSVideoWindowEx2.SetVideoZOrder; var input : IPin; enum : IEnumPins; ColorKey : TColorKey; dwColorKey : DWord; MPC : IMixerPinConfig; begin if not GraphBuildOK then Exit; try ColorKey.KeyType := CK_INDEX or CK_RGB; ColorKey.PaletteIndex := 0; ColorKey.LowColorValue := $000F000F; ColorKey.HighColorValue := $000F000F; FVideoWindowHandle := findWindowEx(Parent.handle, 0, 'VideoRenderer', pchar(name)); if FVideoWindowHandle = 0 then FVideoWindowHandle := findWindowEx(0, 0, 'VideoRenderer', pchar(name)); if FVideoWindowHandle = 0 then Exit; SetWindowPos(FVideoWindowHandle, Handle, 0, 0, 0, 0, SWP_SHOWWINDOW or SWP_NOSIZE or SWP_NOMOVE or SWP_NOCOPYBITS or SWP_NOACTIVATE); if (FVideoWindowHandle <> 0) then begin FOverlayMixer.EnumPins(Enum); Enum.Next(1, Input, nil); if Succeeded(Input.QueryInterface(IID_IMixerPinConfig2, MPC)) then begin MPC.GetColorKey(ColorKey, dwColorKey); FColorKey := ColorKey.HighColorValue; if Assigned(FOnColorKey) then FOnColorKey(Self); end; end; finally Input := nil; Enum := nil; MPC := nil; end; end; function TDSVideoWindowEx2.QueryInterface(const IID: TGUID; out Obj): HResult; begin result := inherited QueryInterface(IID, Obj); if failed(result) and assigned(FBaseFilter) then result := FBaseFilter.QueryInterface(IID, Obj); end; function TDSVideoWindowEx2.UpdateGraph : HResult; Type TConnectAction = (caConnect, caDisConnect); PConnection = ^TConnection; TConnection = record FromPin : IPin; ToPin : IPin; Action : TConnectAction; end; var FilterList : TFilterList; VMRPinList : TPinList; OVMPinList : TPinList; TmpPinList : TPinList; OrigConnections : TList; TmpVMRPinList : TPinList; Connection : pConnection; i, a: integer; GUID: TGUID; pGB : IGraphBuilder; VRInputPin, VRConnectedToPin : IPin; OVMInputPin : IPin; OVMOutputPin : IPIN; Pin : IPin; pEnumPins : IEnumPins; ul : cardinal; pd : TPinDirection; PinInfo : TPinInfo; Hr : HResult; VMR : IBaseFilter; Line21Dec, Line21Dec2 : IBaseFilter; OVMInConected : Boolean; OVMOutConected : Boolean; Found : Boolean; label FailedSoReconnect, Cleanup, SetDrawExclMode; begin // Check if we are using Overlay. FOverlayMixer := nil; FVideoRenderer := nil; VMR := nil; Line21Dec := nil; Line21Dec2 := nil; GraphWasUpdatet := True; OrigConnections := TList.Create; FilterList:= TFilterList.Create(FilterGraph.FFilterGraph); if FilterList.Count > 0 then for i := 0 to FilterList.Count - 1 do begin FilterList.Items[i].GetClassID(GUID); if ISEqualGUID(GUID, CLSID_OverlayMixer) then FOverlayMixer := FilterList.Items[i]; if ISEqualGUID(GUID, CLSID_VideoMixingRenderer) then VMR := FilterList.Items[i]; if ISEqualGUID(GUID, CLSID_VideoRenderer) then FVideoRenderer := FilterList.Items[i]; end; // The Graph holds no overlay mixer filter, Let's add one. Result := FFilterGraph.QueryInterface(IID_IGraphBuilder, pGB); if Failed(Result) then begin Goto Cleanup; end; if FOverlayMixer <> nil then begin // Check if The Overlay Mixer that already exists is connected // correct to out VideoWindow OVMInConected := False; OVMOutConected := False; OVMPinList := TPinList.Create(FOverlayMixer); for i := 0 To OVMPinList.Count -1 do begin OVMPinList.Items[i].QueryDirection(pd); if pd = PINDIR_OUTPUT then begin if Succeeded(OVMPinlist.Items[i].ConnectedTo(Pin)) then begin Pin.QueryPinInfo(PinInfo); if PinInfo.pFilter = FVideoRenderer then OVMOutConected := True; end; end else begin if Succeeded(OVMPinlist.Items[i].ConnectedTo(Pin)) then OVMInConected := True; end; end; if (not OVMOutConected) or (not OVMInConected) then begin Result := E_FAIL; Goto Cleanup; end else begin // Everything looks okay stop here. OVMPinList.Free; Goto SetDrawExclMode; end; end; Result := CoCreateInstance(CLSID_OverlayMixer, nil, CLSCTX_INPROC, IID_IBaseFilter, FOverlayMixer); if Failed(Result) then goto Cleanup; Result := pGB.AddFilter(fOverlayMixer, 'Overlay Mixer'); if Failed(Result) then goto Cleanup; if FVideoRenderer = nil then begin Result := E_Fail; Goto Cleanup; end; Result := FVideoRenderer.EnumPins(pEnumPins); if Failed(Result) then goto Cleanup; Result := pEnumPins.Next(1, VRInputPin, @ul); if Failed(Result) then goto Cleanup; Result := VRInputPin.QueryDirection(pd); if (Failed(Result)) or (PD <> PINDIR_INPUT) then goto Cleanup; if VMR <> nil then begin // The Graph Uses the new VideoMixerRenderer let's try to connect // all filter connected to the VideoMixerRenderer to the Overlay // Mixer filter instead. VMRPinList := TPinList.Create(VMR); OVMPinList := TPinList.Create(FOverlayMixer); TmpVMRPinList := TPinList.Create; I := 0; while (i < VMRPinList.Count) and (Succeeded(VMRPinList.Items[i].ConnectedTo(Pin))) do begin // Let's find the first Input Pin on the overlay mixer not // connected to anything. Result := Pin.Disconnect; if Failed(Result) then goto FailedSoReconnect; Result := VMRPinList.Items[i].Disconnect; if Failed(Result) then goto FailedSoReconnect; New(Connection); Connection^.FromPin := VMRPinList.Items[i]; Connection^.ToPin := Pin; Connection^.Action := caDisconnect; OrigConnections.Add(Connection); TmpVMRPinList.Add(Pin); VMRPinList.Update; Inc(i); end; i := 0; Repeat Pin := TmpVMRPinList[i]; a := 0; Found := False; Repeat OVMPinList.Items[a].QueryDirection(pd); if pd = PINDIR_INPUT then begin OVMInputPin := OVMPinList.Items[a]; if Failed(OVMPinList.Items[a].ConnectedTo(OVMOutputPin)) then begin Found := True; end; end; OVMPinList.Update; inc(a); until (a >= OVMPinList.count) or (Found); if not Found then begin VMRPinList.Free; OVMPinList.Free; Result := E_Fail; goto FailedSoReconnect; end; // Before connecting we need to check if the filter we ar working on is a Line21 Decoder2 // And the exchange it with a Line21 Decoder because The Overlay Mixer Filter cannot connect // with a Line21 Decoder2 Pin.QueryPinInfo(PinInfo); PinInfo.pFilter.GetClassID(GUID); if ISEqualGUID(GUID, CLSID_Line21Decoder2) then begin Line21Dec2 := PinInfo.pFilter; TmpPinList := TPinList.Create(Line21Dec2); Result := TmpPinList.Items[0].ConnectedTo(Pin); if Failed(Result) then goto FailedSoReconnect; Result := TmpPinList.Items[0].Disconnect; if Failed(Result) then goto FailedSoReconnect; Result := Pin.Disconnect; if Failed(Result) then goto FailedSoReconnect; New(Connection); Connection^.FromPin := Pin; Connection^.ToPin := TmpPinList.Items[0]; Connection^.Action := caDisconnect; OrigConnections.Add(Connection); TmpPinList.Free; Result := CoCreateInstance(CLSID_Line21Decoder, nil, CLSCTX_INPROC, IID_IBaseFilter, Line21Dec); if Failed(Result) then goto Cleanup; Result := FilterGraph.FFilterGraph.AddFilter(Line21Dec, 'Line21 Decoder'); if Failed(Result) then goto Cleanup; TmpPinList := TPinList.Create(Line21Dec); Result := FilterGraph.FFilterGraph.Connect(Pin, TmpPinList.Items[0]); if Failed(Result) then goto Cleanup; New(Connection); Connection^.FromPin := Pin; Connection^.ToPin := TmpPinList.Items[0]; Connection^.Action := caConnect; OrigConnections.Add(Connection); Pin := TmpPinList.Items[1]; TmpPinList.Free; Result := pGB.Connect(Pin, OVMInputPin); if Failed(Result) then begin VMRPinList.Free; OVMPinList.Free; Goto Failedsoreconnect; end; New(Connection); Connection^.FromPin := Pin; Connection^.ToPin := OVMInputPin; Connection^.Action := caConnect; OrigConnections.Add(Connection); end else begin Result := pGB.Connect(Pin, OVMInputPin); if Failed(Result) then begin VMRPinList.Free; OVMPinList.Free; Goto Failedsoreconnect; end; New(Connection); Connection^.FromPin := Pin; Connection^.ToPin := OVMInputPin; Connection^.Action := caConnect; OrigConnections.Add(Connection); end; OVMPinList.Update; inc(i); until I >= TmpVMRPinList.Count; VMRPinList.Free; OVMPinList.Free; TmpVMRPinList.Free; end else begin Result := VRInputPin.ConnectedTo(VRConnectedToPin); if Failed(Result) then goto FailedSoReconnect; Result := VRInputPin.Disconnect; if Failed(Result) then goto FailedSoReconnect; Result := VRConnectedToPin.Disconnect; if Failed(Result) then goto FailedSoReconnect; New(Connection); Connection^.FromPin := VRInputPin; Connection^.ToPin := VRConnectedToPin; Connection^.Action := caDisconnect; OrigConnections.Add(Connection); OVMPinList := TPinList.Create(FOverlayMixer); a := 0; Found := False; Repeat OVMPinList.Items[a].QueryDirection(pd); if pd = PINDIR_INPUT then begin OVMInputPin := OVMPinList.Items[a]; if Failed(OVMPinList.Items[a].ConnectedTo(Pin)) then Found := True; end; inc(a); until (a >= OVMPinList.count) or (Found); if not Found then begin OVMPinList.Free; Result := E_Fail; Goto Cleanup; end; result := pGB.Connect(VRConnectedToPin, OVMInputPin); if Failed(Result) then begin OVMPinList.Free; Goto FailedSoReconnect; end; New(Connection); Connection^.FromPin := VRConnectedToPin; Connection^.ToPin := OVMInputPin; Connection^.Action := caConnect; OrigConnections.Add(Connection); OVMPinList.Free; end; Result := FOverlayMixer.FindPin('Output', OVMOutputPin); if Failed(Result) then goto FailedSoReconnect; Result := pGB.Connect(OVMOutputPin, VRInputPin); if Failed(Result) then goto FailedSoReconnect; New(Connection); Connection^.FromPin := OVMOutputPin; Connection^.ToPin := VRInputPin; Connection^.Action := caConnect; OrigConnections.Add(Connection); SetDrawExclMode: Result := FOverlayMixer.QueryInterface(IID_IDDrawExclModeVideo, FDDXM); if Failed(Result) then goto FailedSoReconnect; OverlayCallback := TOverlayCallback.Create(Self); Result := FDDXM.SetCallbackInterface(OverlayCallBack, 0); if Failed(Result) then goto FailedSoReconnect; if Line21Dec2 <> nil then filtergraph.FFilterGraph.RemoveFilter(Line21Dec2); if VMR <> nil then filtergraph.FFilterGraph.RemoveFilter(VMR); Goto Cleanup; FailedSoReconnect: for i := OrigConnections.Count -1 downto 0 do begin Connection := OrigConnections[i]; Case Connection^.Action of caConnect : begin Connection^.FromPin.Disconnect; Connection^.ToPin.Disconnect; end; caDisconnect : begin pGB.Connect(Connection^.FromPin, Connection^.ToPin); end; end; end; if Line21Dec <> nil then FilterGraph.FFilterGraph.RemoveFilter(Line21Dec); Hr := pGB.RemoveFilter(FOverlayMixer); if Failed(Hr) then begin Result := Hr; Goto CleanUp; end; FOverlayMixer := nil; if VMR <> nil then begin pGB.RemoveFilter((FVideoWindow as IBaseFilter)); FVideoWindow := nil; FVideoRenderer := VMR; FVideoWindow := (VMR as IVIdeoWindow); end; Cleanup: for i := 0 to OrigConnections.Count -1 do begin Connection := OrigConnections[i]; Connection^.FromPin := nil; Connection^.ToPin := nil; end; VMR := nil; pEnumPins := nil; OVMInputpin := nil; OVMOutputPin := nil; VRInputPin := nil; VRConnectedToPin := nil; Line21Dec := nil; Line21Dec2 := nil; OrigConnections.Free; FilterList.Free; end; procedure TDSVideoWindowEx2.WndProc(var Message: TMessage); begin if (csDesigning in ComponentState) then begin inherited WndProc(Message); Exit; end; if ((Message.Msg = WM_CONTEXTMENU) and FullScreen) then begin if assigned(PopupMenu) then if PopupMenu.AutoPopup then begin PopupMenu.Popup(mouse.CursorPos.X, mouse.CursorPos.Y); Message.Result := 1; end; inherited WndProc(Message); Exit; end; if (Message.Msg = WM_ERASEBKGND) and (GraphBuildOk) then begin Message.Result := -1; Exit; end; if FNoScreenSaver then if (Message.Msg = SC_SCREENSAVE) or (Message.Msg = SC_MONITORPOWER) then begin Message.Result := 0; Exit; end; inherited WndProc(Message); end; procedure TDSVideoWindowEx2.ClearBack; var DC, MemDC: HDC; MemBitmap, OldBitmap: HBITMAP; BackBrush, OverlayBrush : HBrush; begin BackBrush := 0; OverlayBrush := 0; if (csDestroying in componentstate) then exit; DC := GetDC(0); MemBitmap := CreateCompatibleBitmap(DC, ClientRect.Right, ClientRect.Bottom); ReleaseDC(0, DC); MemDC := CreateCompatibleDC(0); OldBitmap := SelectObject(MemDC, MemBitmap); try DC := GetDC(Handle); BackBrush := CreateSolidBrush(Color); FillRect(MemDC, Rect(0,0, ClientRect.Right, ClientRect.Bottom), BackBrush); if not (csDesigning in ComponentState) then begin if Succeeded(GetVideoInfo) and (FOverlayVisible) then begin OverlayBrush := CreateSolidBrush(FColorKey); FillRect(MemDC, FVideoRect, OverlayBrush); end; end; BitBlt(DC, 0, 0, Self.ClientRect.Right, Self.ClientRect.Bottom, MemDC, 0, 0, SRCCOPY); finally SelectObject(MemDC, OldBitmap); DeleteDC(MemDC); DeleteObject(MemBitmap); DeleteObject(BackBrush); DeleteObject(OverlayBrush); ReleaseDC(Handle, DC); end; if Assigned(FOnPaint) then FOnPaint(self); end; procedure TDSVideoWindowEx2.Paint; begin inherited Paint; clearback; if Assigned(FOnPaint) then FOnPaint(self); end; function TDSVideoWindowEx2.GetVideoInfo : HResult; Var BasicVideo : IBasicVideo2; AspX, AspY : DWord; VideoWidth, VideoHeight : DWord; begin Result := E_Fail; if (FVideoWindow = nil) or (FBaseFilter = nil) or (FDDXM = nil) or (FVideoRenderer = nil) or (FOverlayMixer = nil) then Exit; try if FAspectMode = rmLetterbox then begin FDDXM.GetNativeVideoProps(VideoWidth, VideoHeight, AspX, AspY); FVideoRect := StretchRect(ClientRect, Rect(0,0, AspX, AspY)); end else FVideoRect := ClientRect; Result := S_OK; finally BasicVideo := nil; end; end; Procedure TDSVideoWindowEx2.StartDesktopPlayback; type TMonitorDefaultTo = (mdNearest, mdNull, mdPrimary); const MonitorDefaultFlags: array[TMonitorDefaultTo] of DWORD = (MONITOR_DEFAULTTONEAREST, MONITOR_DEFAULTTONULL, MONITOR_DEFAULTTOPRIMARY); function FindMonitor(Handle: HMONITOR): TMonitor; var I: Integer; begin Result := nil; for I := 0 to Screen.MonitorCount - 1 do if HMonitor(Screen.Monitors[I].Handle) = HMonitor(Handle) then begin Result := Screen.Monitors[I]; break; end; end; function MonitorFromWindow(const Handle: THandle; MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor; begin Result := FindMonitor(MultiMon.MonitorFromWindow(Handle, MonitorDefaultFlags[MonitorDefault])); end; begin StartDesktopPlayback(MonitorfromWindow(Self.Handle)); end; procedure TDSVideoWindowEx2.StartDesktopPlayBack(OnMonitor : TMonitor); procedure SetWallpaper(sWallpaperBMPPath : String); var reg : TRegistry; begin reg := TRegistry.Create; with reg do begin RootKey := HKEY_CURRENT_USER; if KeyExists('\Control Panel\Desktop') then if OpenKey('\Control Panel\Desktop', False) then begin if ValueExists('WallPaper') then WriteString('WallPaper', sWallpaperBMPPath); end; end; reg.Free; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE ); end; function GetWallpaper : String; var reg : TRegistry; begin Result := ''; reg := TRegistry.Create; with reg do begin RootKey := HKEY_CURRENT_USER; if KeyExists('\Control Panel\Desktop') then if OpenKey('\Control Panel\Desktop', False) then begin if ValueExists('WallPaper') then Result := ReadString('Wallpaper'); end; end; reg.Free; end; var ColorIndex : Integer; Color : Longint; begin if DesktopPlayback then Exit; FMonitor := OnMonitor; OldDesktopPic := GetWallpaper; ColorIndex:=COLOR_DESKTOP; OldDesktopColor := GetSysColor(ColorIndex); SetWallPaper(''); Color := ColorTorgb(FColorKey); SetSysColors(1, ColorIndex, Color); if FullScreen then NormalPlayback; FOldParent := Parent; Parent := FFullScreenControl; FFullScreenControl.BoundsRect := rect(OnMonitor.Left, OnMonitor.Top, OnMonitor.Left + OnMonitor.Width, OnMonitor.Top + OnMonitor.Height); FFullScreenControl.Show; FDesktopPlay := True; RefreshVideoWindow; if GraphBuildOk then SetVideoZOrder; FFullScreenControl.Hide; FOverlayVisible := False; ClearBack; if Assigned(FOnOverlay) then FOnOverlay(Self, False); end; procedure TDSVideoWindowEx2.NormalPlayback; procedure SetWallpaper(sWallpaperBMPPath : String); var reg : TRegistry; begin reg := TRegistry.Create; with reg do begin RootKey := HKEY_CURRENT_USER; if KeyExists('\Control Panel\Desktop') then if OpenKey('\Control Panel\Desktop', False) then begin if ValueExists('WallPaper') then WriteString('WallPaper', sWallpaperBMPPath); end; end; reg.Free; SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, nil, SPIF_SENDWININICHANGE ); end; var ColorIndex : Integer; begin if DesktopPlayback then begin ColorIndex := COLOR_DESKTOP; SetWallPaper(OldDesktopPic); SetSysColors(1, ColorIndex, OldDesktopColor); FDesktopPlay := False; if (csDestroying in componentstate) then exit; end; if FoldParent <> nil then Parent := FOldParent; if FullScreen then begin FFullScreenControl.Hide; FFullScreenControl.Invalidate; FFullScreen := False; end; RefreshVideoWindow; if GraphBuildOk then SetVideoZOrder; FOverlayVisible := True; ClearBack; if Assigned(FOnOverlay) then FOnOverlay(Self, True); FMonitor := nil; end; procedure TDSVideoWindowEx2.StartFullScreen; type TMonitorDefaultTo = (mdNearest, mdNull, mdPrimary); const MonitorDefaultFlags: array[TMonitorDefaultTo] of DWORD = (MONITOR_DEFAULTTONEAREST, MONITOR_DEFAULTTONULL, MONITOR_DEFAULTTOPRIMARY); function FindMonitor(Handle: HMONITOR): TMonitor; var I: Integer; begin Result := nil; for I := 0 to Screen.MonitorCount - 1 do if HMonitor(Screen.Monitors[I].Handle) = HMonitor(Handle) then begin Result := Screen.Monitors[I]; break; end; end; function MonitorFromWindow(const Handle: THandle; MonitorDefault: TMonitorDefaultTo = mdNearest): TMonitor; begin Result := FindMonitor(MultiMon.MonitorFromWindow(Handle, MonitorDefaultFlags[MonitorDefault])); end; begin StartFullScreen(MonitorfromWindow(Self.Handle)); end; procedure TDSVideoWindowEx2.StartFullScreen(OnMonitor : TMonitor); begin if FFullscreen then Exit; if DesktopPlayback then NormalPlayback; FMonitor := OnMonitor; FOldParent := Parent; Parent := FFullScreenControl; FFullScreenControl.BoundsRect := rect(OnMonitor.Left, OnMonitor.Top, OnMonitor.Left + OnMonitor.Width, OnMonitor.Top + OnMonitor.Height); if FTopMost then FFullScreenControl.FormStyle := fsStayOnTop Else FFullScreenControl.FormStyle := fsNormal; FFullScreenControl.Show; FFullScreen := True; RefreshVideoWindow; if GraphBuildOk then SetVideoZOrder; end; procedure TDSVideoWindowEx2.FullScreenCloseQuery(Sender: TObject; var CanClose: Boolean); begin if csDestroying in componentstate then begin NormalPlayback; CanClose := True; end else CanClose := False; end; procedure TDSVideoWindowEx2.SetZoom(Value : Integer); var Ratio : Real; TmpX, TmpY : Real; TmpLeft, TmpTop : Real; BasicVideo2 : IBasicVideo2; SLeft, STop, SWidth, SHeight : Integer; begin // Set DigitalZoom if (Value < 0) or (Value > 99) then begin raise Exception.CreateFmt('Value %d out of range. Value must bee between 0 -> 99', [Value]); Exit; end; if (csDesigning in ComponentState) or (FVideoRenderer = nil) then begin FZoom := Value; Exit; end; BasicVideo2 := nil; try if (FVideoRenderer.QueryInterface(IID_IBasicVideo2, BasicVideo2) = S_OK) then begin BasicVideo2.SetDefaultSourcePosition; BasicVideo2.get_SourceLeft(SLeft); BasicVideo2.get_SourceTop(STop); BasicVideo2.get_SourceWidth(SWidth); BasicVideo2.get_SourceHeight(SHeight); Ratio := SHeight / SWidth; TmpX := SWidth - ((Value * Swidth) / 100); TmpY := TmpX * Ratio; TmpLeft := (SWidth - TmpX) / 2; TmpTop := (SHeight - TmpY) / 2; BasicVideo2.put_SourceWidth(Trunc(TmpX)); BasicVideo2.put_SourceHeight(Trunc(TmpY)); BasicVideo2.put_SourceLeft(Trunc(TmpLeft)); BasicVideo2.put_SourceTop(Trunc(TmpTop)); end; FZoom := Value; finally BasicVideo2 := nil; end; end; procedure TDSVideoWindowEx2.SetAspectMode(Value : TRatioModes); var input : IPin; enum : IEnumPins; pMPC : IMixerPinConfig2; begin if (csDesigning in ComponentState) or (FVideoRenderer = nil) or (FOverlayMixer = nil) then begin FAspectMode := Value; Exit; end; try FOverlayMixer.EnumPins(Enum); Enum.Next(1, Input, nil); if Succeeded(Input.QueryInterface(IID_IMixerPinConfig2, pMPC)) then if Succeeded(pMPC.SetAspectRatioMode(TAMAspectRatioMode(integer(Value)))) then FAspectMode := Value; finally input := nil; enum := nil; pMPC := nil; end; if (GraphBuildOk) and (not FDesktopPlay) then Clearback; end; procedure TDSVideoWindowEx2.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Var MPos : TPoint; begin if Ffullscreen then MPos := Point(mouse.CursorPos.X, mouse.CursorPos.Y) else MPos := Point(X, Y); if FVideoWindow <> nil then begin if GraphBuildOK then begin if Self.Cursor = crnone then begin Self.Cursor := RememberCursor; LMousePos.X := MPos.X; LMousePos.Y := MPos.Y; LCursorMov := GetTickCount; if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, True); end; end else begin FVideoWindow.IsCursorHidden(IsHidden); if IsHidden then begin FVideoWindow.HideCursor(False); LMousePos.X := MPos.X; LMousePos.Y := MPos.Y; LCursorMov := GetTickCount; IsHidden := False; if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, True); end; end; end; inherited MouseDown(Button, Shift, MPos.X, MPos.Y); end; procedure TDSVideoWindowEx2.MouseMove(Shift: TShiftState; X, Y: Integer); var MPos : TPoint; begin if Ffullscreen then MPos := Point(mouse.CursorPos.X, mouse.CursorPos.Y) else MPos := Point(X, Y); if (LMousePos.X <> MPos.X) or (LMousePos.Y <> MPos.Y) then begin LMousePos.X := MPos.X; LMousePos.Y := MPos.Y; LCursorMov := GetTickCount; if FVideoWindow <> nil then begin if GraphBuildOk then begin if Self.Cursor = crnone then begin Self.Cursor := RememberCursor; if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, True); end; end else begin FVideoWindow.IsCursorHidden(IsHidden); if IsHidden then begin FVideoWindow.HideCursor(False); IsHidden := False; if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, True); end; end; end; end; inherited MouseMove(Shift, MPos.X, MPos.Y); end; procedure TDSVideoWindowEx2.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var MPos : TPoint; begin if Ffullscreen then MPos := Point(mouse.CursorPos.X, mouse.CursorPos.Y) else MPos := Point(X, Y); if FVideoWindow <> nil then begin if GraphBuildOK then begin if Self.Cursor = crnone then begin Self.Cursor := RememberCursor; LMousePos.X := MPos.X; LMousePos.Y := MPos.Y; LCursorMov := GetTickCount; if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, True); end; end else begin FVideoWindow.IsCursorHidden(IsHidden); if IsHidden then begin FVideoWindow.HideCursor(False); LMousePos.X := MPos.X; LMousePos.Y := MPos.Y; LCursorMov := GetTickCount; IsHidden := False; if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, True); end; end; end; inherited MouseUp(Button, Shift, MPos.X, MPos.Y); end; procedure TDSVideoWindowEx2.MyIdleHandler(Sender: TObject; var Done: Boolean); var pt : TPoint; begin Done := True; if (FIdleCursor = 0) or (csDesigning in ComponentState) then exit; if (GetTickCount - LCursorMov >= Cardinal(FIdleCursor)) and (FVideoWindow <> nil) then begin if GraphBuildOK then begin if Self.Cursor <> crNone then begin RememberCursor := Self.Cursor; Self.Cursor := crNone; GetCursorPos(pt); SetCursorPos(pt.x, pt.y); if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, False); end; end else begin FVideoWindow.IsCursorHidden(IsHidden); if not IsHidden then begin FVideoWindow.HideCursor(True); IsHidden := True; GetCursorPos(pt); SetCursorPos(pt.x, pt.y); if Assigned(FOnCursorVisible) then FOnCursorVisible(Self, False); end; end; end; end; { TVMRBitmap } constructor TVMRBitmap.Create(VideoWindow: TVideoWindow); begin Assert(Assigned(VideoWindow),'No valid video Window.'); FCanvas := TCanvas.Create; FVideoWindow := VideoWindow; FillChar(FVMRALPHABITMAP, SizeOf(FVMRALPHABITMAP), 0); Options := []; FVMRALPHABITMAP.hdc := 0; FVMRALPHABITMAP.fAlpha := 1; end; destructor TVMRBitmap.Destroy; begin ResetBitmap; FCanvas.Free; end; procedure TVMRBitmap.Draw; var VMRMixerBitmap: IVMRMixerBitmap9; begin if Succeeded(FVideoWindow.QueryInterface(IVMRMixerBitmap9, VMRMixerBitmap)) then VMRMixerBitmap.SetAlphaBitmap(@FVMRALPHABITMAP); end; procedure TVMRBitmap.DrawTo(Left, Top, Right, Bottom, Alpha: Single; doUpdate: boolean = false); begin with FVMRALPHABITMAP do begin rDest.left := Left; rDest.top := Top; rDest.right := Right; rDest.bottom := Bottom; fAlpha := Alpha; end; if doUpdate then Update else Draw; end; function TVMRBitmap.GetAlpha: Single; begin result := FVMRALPHABITMAP.fAlpha; end; function TVMRBitmap.GetColorKey: COLORREF; begin Result := FVMRALPHABITMAP.clrSrcKey; end; function TVMRBitmap.GetDest: TVMR9NormalizedRect; begin Result := FVMRALPHABITMAP.rDest; end; function TVMRBitmap.GetDestBottom: Single; begin Result := FVMRALPHABITMAP.rDest.bottom; end; function TVMRBitmap.GetDestLeft: Single; begin Result := FVMRALPHABITMAP.rDest.Left; end; function TVMRBitmap.GetDestRight: Single; begin Result := FVMRALPHABITMAP.rDest.right end; function TVMRBitmap.GetDestTop: Single; begin Result := FVMRALPHABITMAP.rDest.top; end; function TVMRBitmap.GetSource: TRect; begin result := FVMRALPHABITMAP.rSrc; end; procedure TVMRBitmap.LoadBitmap(Bitmap: TBitmap); var TmpHDC, HdcBMP: HDC; BMP: Windows.TBITMAP; begin Assert(Assigned(Bitmap),'Invalid Bitmap.'); ResetBitmap; TmpHDC := GetDC(FVideoWindow.Handle); if (TmpHDC = 0) then Exit; HdcBMP := CreateCompatibleDC(TmpHDC); ReleaseDC(FVideoWindow.Handle, TmpHDC); if (HdcBMP = 0) then Exit; if (0 = GetObject(Bitmap.Handle, sizeof(BMP), @BMP)) then exit; FBMPOld := SelectObject(HdcBMP, Bitmap.Handle); if (FBMPOld = 0) then Exit; FVMRALPHABITMAP.hdc := HdcBMP; FCanvas.Handle := HdcBMP; end; procedure TVMRBitmap.LoadEmptyBitmap(Width, Height: Integer; PixelFormat: TPixelFormat; Color: TColor); var Bitmap: TBitmap; begin Bitmap := TBitmap.Create; try Bitmap.Width := Width; Bitmap.Height := Height; Bitmap.PixelFormat := PixelFormat; Bitmap.Canvas.Brush.Color := Color; Bitmap.Canvas.FillRect(Bitmap.Canvas.ClipRect); LoadBitmap(Bitmap); finally Bitmap.Free; end; end; procedure TVMRBitmap.ResetBitmap; begin FCanvas.Handle := 0; if FVMRALPHABITMAP.hdc <> 0 then begin DeleteObject(SelectObject(FVMRALPHABITMAP.hdc, FBMPOld)); DeleteDC(FVMRALPHABITMAP.hdc); FVMRALPHABITMAP.hdc := 0; end; end; procedure TVMRBitmap.SetAlpha(const Value: Single); begin FVMRALPHABITMAP.fAlpha := Value; end; procedure TVMRBitmap.SetColorKey(const Value: COLORREF); begin FVMRALPHABITMAP.clrSrcKey := Value; end; procedure TVMRBitmap.SetDest(const Value: TVMR9NormalizedRect); begin FVMRALPHABITMAP.rDest := Value; end; procedure TVMRBitmap.SetDestBottom(const Value: Single); begin FVMRALPHABITMAP.rDest.bottom := Value; end; procedure TVMRBitmap.SetDestLeft(const Value: Single); begin FVMRALPHABITMAP.rDest.Left := Value; end; procedure TVMRBitmap.SetDestRight(const Value: Single); begin FVMRALPHABITMAP.rDest.right := Value; end; procedure TVMRBitmap.SetDestTop(const Value: Single); begin FVMRALPHABITMAP.rDest.top := Value; end; procedure TVMRBitmap.SetOptions(Options: TVMRBitmapOptions); begin FOptions := Options; FVMRALPHABITMAP.dwFlags := VMR9AlphaBitmap_hDC; if vmrbDisable in Options then FVMRALPHABITMAP.dwFlags := FVMRALPHABITMAP.dwFlags or VMR9AlphaBitmap_Disable; if vmrbSrcColorKey in Options then FVMRALPHABITMAP.dwFlags := FVMRALPHABITMAP.dwFlags or VMR9AlphaBitmap_SrcColorKey; if vmrbSrcRect in Options then FVMRALPHABITMAP.dwFlags := FVMRALPHABITMAP.dwFlags or VMR9AlphaBitmap_SrcRect; end; procedure TVMRBitmap.SetSource(const Value: TRect); begin FVMRALPHABITMAP.rSrc := Value; end; procedure TVMRBitmap.Update; var VMRMixerBitmap: IVMRMixerBitmap9; begin if Succeeded(FVideoWindow.QueryInterface(IVMRMixerBitmap9, VMRMixerBitmap)) then VMRMixerBitmap.UpdateAlphaBitmapParameters(@FVMRALPHABITMAP); end; end. 
